home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / perl5000.zip / perl5000 / pp_sys.c < prev    next >
C/C++ Source or Header  |  1994-10-17  |  69KB  |  3,812 lines
  1. /*    pp_sys.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * But only a short way ahead its floor and the walls on either side were
  12.  * cloven by a great fissure, out of which the red glare came, now leaping
  13.  * up, now dying down into darkness; and all the while far below there was
  14.  * a rumour and a trouble as of great engines throbbing and labouring.
  15.  */
  16.  
  17. #include "EXTERN.h"
  18. #include "perl.h"
  19.  
  20. /* Omit this -- it causes too much grief on mixed systems.
  21. #ifdef I_UNISTD
  22. #include <unistd.h>
  23. #endif
  24. */
  25.  
  26. #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
  27. # include <sys/socket.h>
  28. # include <netdb.h>
  29. # ifndef ENOTSOCK
  30. #  ifdef I_NET_ERRNO
  31. #   include <net/errno.h>
  32. #  endif
  33. # endif
  34. #endif
  35.  
  36. #ifdef HAS_SELECT
  37. #ifdef I_SYS_SELECT
  38. #ifndef I_SYS_TIME
  39. #include <sys/select.h>
  40. #endif
  41. #endif
  42. #endif
  43.  
  44. #ifdef HOST_NOT_FOUND
  45. extern int h_errno;
  46. #endif
  47.  
  48. #ifdef HAS_PASSWD
  49. # ifdef I_PWD
  50. #  include <pwd.h>
  51. # else
  52.     struct passwd *getpwnam _((char *));
  53.     struct passwd *getpwuid _((Uid_t));
  54. # endif
  55.   struct passwd *getpwent _((void));
  56. #endif
  57.  
  58. #ifdef HAS_GROUP
  59. # ifdef I_GRP
  60. #  include <grp.h>
  61. # else
  62.     struct group *getgrnam _((char *));
  63.     struct group *getgrgid _((Gid_t));
  64. # endif
  65.     struct group *getgrent _((void));
  66. #endif
  67.  
  68. #ifdef I_UTIME
  69. #include <utime.h>
  70. #endif
  71. #ifdef I_FCNTL
  72. #include <fcntl.h>
  73. #endif
  74. #ifdef I_SYS_FILE
  75. #include <sys/file.h>
  76. #endif
  77.  
  78. #ifdef HAS_GETPGRP2
  79. #   define getpgrp getpgrp2
  80. #endif
  81.  
  82. #ifdef HAS_SETPGRP2
  83. #   define setpgrp setpgrp2
  84. #endif
  85.  
  86. #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
  87. static int dooneliner _((char *cmd, char *filename));
  88. #endif
  89. /* Pushy I/O. */
  90.  
  91. PP(pp_backtick)
  92. {
  93.     dSP; dTARGET;
  94.     FILE *fp;
  95.     char *tmps = POPp;
  96.     TAINT_PROPER("``");
  97.     fp = my_popen(tmps, "r");
  98.     if (fp) {
  99.     sv_setpv(TARG, "");    /* note that this preserves previous buffer */
  100.     if (GIMME == G_SCALAR) {
  101.         while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
  102.         /*SUPPRESS 530*/
  103.         ;
  104.         XPUSHs(TARG);
  105.     }
  106.     else {
  107.         SV *sv;
  108.  
  109.         for (;;) {
  110.         sv = NEWSV(56, 80);
  111.         if (sv_gets(sv, fp, 0) == Nullch) {
  112.             SvREFCNT_dec(sv);
  113.             break;
  114.         }
  115.         XPUSHs(sv_2mortal(sv));
  116.         if (SvLEN(sv) - SvCUR(sv) > 20) {
  117.             SvLEN_set(sv, SvCUR(sv)+1);
  118.             Renew(SvPVX(sv), SvLEN(sv), char);
  119.         }
  120.         }
  121.     }
  122.     statusvalue = my_pclose(fp);
  123.     }
  124.     else {
  125.     statusvalue = -1;
  126.     if (GIMME == G_SCALAR)
  127.         RETPUSHUNDEF;
  128.     }
  129.  
  130.     RETURN;
  131. }
  132.  
  133. PP(pp_glob)
  134. {
  135.     OP *result;
  136.     ENTER;
  137.     SAVEINT(rschar);
  138.     SAVEINT(rslen);
  139.  
  140.     SAVESPTR(last_in_gv);    /* We don't want this to be permanent. */
  141.     last_in_gv = (GV*)*stack_sp--;
  142.  
  143.     rslen = 1;
  144. #ifdef DOSISH
  145.     rschar = 0;
  146. #else
  147. #ifdef CSH
  148.     rschar = 0;
  149. #else
  150.     rschar = '\n';
  151. #endif    /* !CSH */
  152. #endif    /* !MSDOS */
  153.     result = do_readline();
  154.     LEAVE;
  155.     return result;
  156. }
  157.  
  158. PP(pp_indread)
  159. {
  160.     last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), na), TRUE,SVt_PVIO);
  161.     return do_readline();
  162. }
  163.  
  164. PP(pp_rcatline)
  165. {
  166.     last_in_gv = cGVOP->op_gv;
  167.     return do_readline();
  168. }
  169.  
  170. PP(pp_warn)
  171. {
  172.     dSP; dMARK;
  173.     char *tmps;
  174.     if (SP - MARK != 1) {
  175.     dTARGET;
  176.     do_join(TARG, &sv_no, MARK, SP);
  177.     tmps = SvPV(TARG, na);
  178.     SP = MARK + 1;
  179.     }
  180.     else {
  181.     tmps = SvPV(TOPs, na);
  182.     }
  183.     if (!tmps || !*tmps) {
  184.     SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
  185.     (void)SvUPGRADE(error, SVt_PV);
  186.     if (SvPOK(error) && SvCUR(error))
  187.         sv_catpv(error, "\t...caught");
  188.     tmps = SvPV(error, na);
  189.     }
  190.     if (!tmps || !*tmps)
  191.     tmps = "Warning: something's wrong";
  192.     warn("%s", tmps);
  193.     RETSETYES;
  194. }
  195.  
  196. PP(pp_die)
  197. {
  198.     dSP; dMARK;
  199.     char *tmps;
  200.     if (SP - MARK != 1) {
  201.     dTARGET;
  202.     do_join(TARG, &sv_no, MARK, SP);
  203.     tmps = SvPV(TARG, na);
  204.     SP = MARK + 1;
  205.     }
  206.     else {
  207.     tmps = SvPV(TOPs, na);
  208.     }
  209.     if (!tmps || !*tmps) {
  210.     SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
  211.     (void)SvUPGRADE(error, SVt_PV);
  212.     if (SvPOK(error) && SvCUR(error))
  213.         sv_catpv(error, "\t...propagated");
  214.     tmps = SvPV(error, na);
  215.     }
  216.     if (!tmps || !*tmps)
  217.     tmps = "Died";
  218.     DIE("%s", tmps);
  219. }
  220.  
  221. /* I/O. */
  222.  
  223. PP(pp_open)
  224. {
  225.     dSP; dTARGET;
  226.     GV *gv;
  227.     SV *sv;
  228.     char *tmps;
  229.     STRLEN len;
  230.  
  231.     if (MAXARG > 1)
  232.     sv = POPs;
  233.     else
  234.     sv = GvSV(TOPs);
  235.     gv = (GV*)POPs;
  236.     tmps = SvPV(sv, len);
  237.     if (do_open(gv, tmps, len,Nullfp)) {
  238.     IoLINES(GvIOp(gv)) = 0;
  239.     PUSHi( (I32)forkprocess );
  240.     }
  241.     else if (forkprocess == 0)        /* we are a new child */
  242.     PUSHi(0);
  243.     else
  244.     RETPUSHUNDEF;
  245.     RETURN;
  246. }
  247.  
  248. PP(pp_close)
  249. {
  250.     dSP;
  251.     GV *gv;
  252.  
  253.     if (MAXARG == 0)
  254.     gv = defoutgv;
  255.     else
  256.     gv = (GV*)POPs;
  257.     EXTEND(SP, 1);
  258.     PUSHs( do_close(gv, TRUE) ? &sv_yes : &sv_no );
  259.     RETURN;
  260. }
  261.  
  262. PP(pp_pipe_op)
  263. {
  264.     dSP;
  265. #ifdef HAS_PIPE
  266.     GV *rgv;
  267.     GV *wgv;
  268.     register IO *rstio;
  269.     register IO *wstio;
  270.     int fd[2];
  271.  
  272.     wgv = (GV*)POPs;
  273.     rgv = (GV*)POPs;
  274.  
  275.     if (!rgv || !wgv)
  276.     goto badexit;
  277.  
  278.     rstio = GvIOn(rgv);
  279.     wstio = GvIOn(wgv);
  280.  
  281.     if (IoIFP(rstio))
  282.     do_close(rgv, FALSE);
  283.     if (IoIFP(wstio))
  284.     do_close(wgv, FALSE);
  285.  
  286.     if (pipe(fd) < 0)
  287.     goto badexit;
  288.  
  289.     IoIFP(rstio) = fdopen(fd[0], "r");
  290.     IoOFP(wstio) = fdopen(fd[1], "w");
  291.     IoIFP(wstio) = IoOFP(wstio);
  292.     IoTYPE(rstio) = '<';
  293.     IoTYPE(wstio) = '>';
  294.  
  295.     if (!IoIFP(rstio) || !IoOFP(wstio)) {
  296.     if (IoIFP(rstio)) fclose(IoIFP(rstio));
  297.     else close(fd[0]);
  298.     if (IoOFP(wstio)) fclose(IoOFP(wstio));
  299.     else close(fd[1]);
  300.     goto badexit;
  301.     }
  302.  
  303.     RETPUSHYES;
  304.  
  305. badexit:
  306.     RETPUSHUNDEF;
  307. #else
  308.     DIE(no_func, "pipe");
  309. #endif
  310. }
  311.  
  312. PP(pp_fileno)
  313. {
  314.     dSP; dTARGET;
  315.     GV *gv;
  316.     IO *io;
  317.     FILE *fp;
  318.     if (MAXARG < 1)
  319.     RETPUSHUNDEF;
  320.     gv = (GV*)POPs;
  321.     if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io)))
  322.     RETPUSHUNDEF;
  323.     PUSHi(fileno(fp));
  324.     RETURN;
  325. }
  326.  
  327. PP(pp_umask)
  328. {
  329.     dSP; dTARGET;
  330.     int anum;
  331.  
  332. #ifdef HAS_UMASK
  333.     if (MAXARG < 1) {
  334.     anum = umask(0);
  335.     (void)umask(anum);
  336.     }
  337.     else
  338.     anum = umask(POPi);
  339.     TAINT_PROPER("umask");
  340.     XPUSHi(anum);
  341. #else
  342.     DIE(no_func, "Unsupported function umask");
  343. #endif
  344.     RETURN;
  345. }
  346.  
  347. PP(pp_binmode)
  348. {
  349.     dSP;
  350.     GV *gv;
  351.     IO *io;
  352.     FILE *fp;
  353.  
  354.     if (MAXARG < 1)
  355.     RETPUSHUNDEF;
  356.  
  357.     gv = (GV*)POPs;
  358.  
  359.     EXTEND(SP, 1);
  360.     if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
  361.     RETSETUNDEF;
  362.  
  363. #ifdef DOSISH
  364. #ifdef atarist
  365.     if (!fflush(fp) && (fp->_flag |= _IOBIN))
  366.     RETPUSHYES;
  367.     else
  368.     RETPUSHUNDEF;
  369. #else
  370.     if (setmode(fileno(fp), OP_BINARY) != -1)
  371.     RETPUSHYES;
  372.     else
  373.     RETPUSHUNDEF;
  374. #endif
  375. #else
  376.     RETPUSHYES;
  377. #endif
  378. }
  379.  
  380. PP(pp_tie)
  381. {
  382.     dSP;
  383.     SV *varsv;
  384.     HV* stash;
  385.     GV *gv;
  386.     BINOP myop;
  387.     SV *sv;
  388.     SV **mark = stack_base + ++*markstack_ptr;    /* reuse in entersub */
  389.     I32 markoff = mark - stack_base - 1;
  390.     char *methname;
  391.  
  392.     varsv = mark[0];
  393.     if (SvTYPE(varsv) == SVt_PVHV)
  394.     methname = "TIEHASH";
  395.     else if (SvTYPE(varsv) == SVt_PVAV)
  396.     methname = "TIEARRAY";
  397.     else if (SvTYPE(varsv) == SVt_PVGV)
  398.     methname = "TIEHANDLE";
  399.     else
  400.     methname = "TIESCALAR";
  401.  
  402.     stash = gv_stashsv(mark[1], FALSE);
  403.     if (!stash || !(gv = gv_fetchmethod(stash, methname)) || !GvCV(gv))
  404.     DIE("Can't locate object method \"%s\" via package \"%s\"",
  405.         methname, SvPV(mark[1],na));
  406.  
  407.     Zero(&myop, 1, BINOP);
  408.     myop.op_last = (OP *) &myop;
  409.     myop.op_next = Nullop;
  410.     myop.op_flags = OPf_KNOW|OPf_STACKED;
  411.  
  412.     ENTER;
  413.     SAVESPTR(op);
  414.     op = (OP *) &myop;
  415.  
  416.     XPUSHs(gv);
  417.     PUTBACK;
  418.  
  419.     if (op = pp_entersub())
  420.         run();
  421.     SPAGAIN;
  422.  
  423.     sv = TOPs;
  424.     if (sv_isobject(sv)) {
  425.     if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) {
  426.         sv_unmagic(varsv, 'P');
  427.         sv_magic(varsv, sv, 'P', Nullch, 0);
  428.     }
  429.     else {
  430.         sv_unmagic(varsv, 'q');
  431.         sv_magic(varsv, sv, 'q', Nullch, 0);
  432.     }
  433.     }
  434.     LEAVE;
  435.     SP = stack_base + markoff;
  436.     PUSHs(sv);
  437.     RETURN;
  438. }
  439.  
  440. PP(pp_untie)
  441. {
  442.     dSP;
  443.     if (SvTYPE(TOPs) == SVt_PVHV || SvTYPE(TOPs) == SVt_PVAV)
  444.     sv_unmagic(TOPs, 'P');
  445.     else
  446.     sv_unmagic(TOPs, 'q');
  447.     RETSETYES;
  448. }
  449.  
  450. PP(pp_dbmopen)
  451. {
  452.     dSP;
  453.     HV *hv;
  454.     dPOPPOPssrl;
  455.     HV* stash;
  456.     GV *gv;
  457.     BINOP myop;
  458.     SV *sv;
  459.  
  460.     hv = (HV*)POPs;
  461.  
  462.     sv = sv_mortalcopy(&sv_no);
  463.     sv_setpv(sv, "AnyDBM_File");
  464.     stash = gv_stashsv(sv, FALSE);
  465.     if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv)) {
  466.     PUTBACK;
  467.     perl_requirepv("AnyDBM_File.pm");
  468.     SPAGAIN;
  469.     if (!(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv))
  470.         DIE("No dbm on this machine");
  471.     }
  472.  
  473.     Zero(&myop, 1, BINOP);
  474.     myop.op_last = (OP *) &myop;
  475.     myop.op_next = Nullop;
  476.     myop.op_flags = OPf_KNOW|OPf_STACKED;
  477.  
  478.     ENTER;
  479.     SAVESPTR(op);
  480.     op = (OP *) &myop;
  481.     PUTBACK;
  482.     pp_pushmark();
  483.  
  484.     EXTEND(sp, 5);
  485.     PUSHs(sv);
  486.     PUSHs(left);
  487.     if (SvIV(right))
  488.     PUSHs(sv_2mortal(newSViv(O_RDWR|O_CREAT)));
  489.     else
  490.     PUSHs(sv_2mortal(newSViv(O_RDWR)));
  491.     PUSHs(right);
  492.     PUSHs(gv);
  493.     PUTBACK;
  494.  
  495.     if (op = pp_entersub())
  496.         run();
  497.     SPAGAIN;
  498.  
  499.     if (!sv_isobject(TOPs)) {
  500.     sp--;
  501.     op = (OP *) &myop;
  502.     PUTBACK;
  503.     pp_pushmark();
  504.  
  505.     PUSHs(sv);
  506.     PUSHs(left);
  507.     PUSHs(sv_2mortal(newSViv(O_RDONLY)));
  508.     PUSHs(right);
  509.     PUSHs(gv);
  510.     PUTBACK;
  511.  
  512.     if (op = pp_entersub())
  513.         run();
  514.     SPAGAIN;
  515.     }
  516.  
  517.     if (sv_isobject(TOPs))
  518.     sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
  519.     LEAVE;
  520.     RETURN;
  521. }
  522.  
  523. PP(pp_dbmclose)
  524. {
  525.     return pp_untie(ARGS);
  526. }
  527.  
  528. PP(pp_sselect)
  529. {
  530.     dSP; dTARGET;
  531. #ifdef HAS_SELECT
  532.     register I32 i;
  533.     register I32 j;
  534.     register char *s;
  535.     register SV *sv;
  536.     double value;
  537.     I32 maxlen = 0;
  538.     I32 nfound;
  539.     struct timeval timebuf;
  540.     struct timeval *tbuf = &timebuf;
  541.     I32 growsize;
  542.     char *fd_sets[4];
  543. #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
  544.     I32 masksize;
  545.     I32 offset;
  546.     I32 k;
  547.  
  548. #   if BYTEORDER & 0xf0000
  549. #    define ORDERBYTE (0x88888888 - BYTEORDER)
  550. #   else
  551. #    define ORDERBYTE (0x4444 - BYTEORDER)
  552. #   endif
  553.  
  554. #endif
  555.  
  556.     SP -= 4;
  557.     for (i = 1; i <= 3; i++) {
  558.     if (!SvPOK(SP[i]))
  559.         continue;
  560.     j = SvCUR(SP[i]);
  561.     if (maxlen < j)
  562.         maxlen = j;
  563.     }
  564.  
  565. #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
  566.     growsize = maxlen;        /* little endians can use vecs directly */
  567. #else
  568. #ifdef NFDBITS
  569.  
  570. #ifndef NBBY
  571. #define NBBY 8
  572. #endif
  573.  
  574.     masksize = NFDBITS / NBBY;
  575. #else
  576.     masksize = sizeof(long);    /* documented int, everyone seems to use long */
  577. #endif
  578.     growsize = maxlen + (masksize - (maxlen % masksize));
  579.     Zero(&fd_sets[0], 4, char*);
  580. #endif
  581.  
  582.     sv = SP[4];
  583.     if (SvOK(sv)) {
  584.     value = SvNV(sv);
  585.     if (value < 0.0)
  586.         value = 0.0;
  587.     timebuf.tv_sec = (long)value;
  588.     value -= (double)timebuf.tv_sec;
  589.     timebuf.tv_usec = (long)(value * 1000000.0);
  590.     }
  591.     else
  592.     tbuf = Null(struct timeval*);
  593.  
  594.     for (i = 1; i <= 3; i++) {
  595.     sv = SP[i];
  596.     if (!SvOK(sv)) {
  597.         fd_sets[i] = 0;
  598.         continue;
  599.     }
  600.     else if (!SvPOK(sv))
  601.         SvPV_force(sv,na);    /* force string conversion */
  602.     j = SvLEN(sv);
  603.     if (j < growsize) {
  604.         Sv_Grow(sv, growsize);
  605.         s = SvPVX(sv) + j;
  606.         while (++j <= growsize) {
  607.         *s++ = '\0';
  608.         }
  609.     }
  610. #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
  611.     s = SvPVX(sv);
  612.     New(403, fd_sets[i], growsize, char);
  613.     for (offset = 0; offset < growsize; offset += masksize) {
  614.         for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
  615.         fd_sets[i][j+offset] = s[(k % masksize) + offset];
  616.     }
  617. #else
  618.     fd_sets[i] = SvPVX(sv);
  619. #endif
  620.     }
  621.  
  622.     nfound = select(
  623.     maxlen * 8,
  624.     (Select_fd_set_t) fd_sets[1],
  625.     (Select_fd_set_t) fd_sets[2],
  626.     (Select_fd_set_t) fd_sets[3],
  627.     tbuf);
  628.     for (i = 1; i <= 3; i++) {
  629.     if (fd_sets[i]) {
  630.         sv = SP[i];
  631. #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
  632.         s = SvPVX(sv);
  633.         for (offset = 0; offset < growsize; offset += masksize) {
  634.         for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
  635.             s[(k % masksize) + offset] = fd_sets[i][j+offset];
  636.         }
  637.         Safefree(fd_sets[i]);
  638. #endif
  639.         SvSETMAGIC(sv);
  640.     }
  641.     }
  642.  
  643.     PUSHi(nfound);
  644.     if (GIMME == G_ARRAY && tbuf) {
  645.     value = (double)(timebuf.tv_sec) +
  646.         (double)(timebuf.tv_usec) / 1000000.0;
  647.     PUSHs(sv = sv_mortalcopy(&sv_no));
  648.     sv_setnv(sv, value);
  649.     }
  650.     RETURN;
  651. #else
  652.     DIE("select not implemented");
  653. #endif
  654. }
  655.  
  656. PP(pp_select)
  657. {
  658.     dSP; dTARGET;
  659.     GV *oldgv = defoutgv;
  660.     if (op->op_private > 0) {
  661.     defoutgv = (GV*)POPs;
  662.     if (!GvIO(defoutgv))
  663.         gv_IOadd(defoutgv);
  664.     }
  665.     gv_efullname(TARG, oldgv);
  666.     XPUSHTARG;
  667.     RETURN;
  668. }
  669.  
  670. PP(pp_getc)
  671. {
  672.     dSP; dTARGET;
  673.     GV *gv;
  674.  
  675.     if (MAXARG <= 0)
  676.     gv = stdingv;
  677.     else
  678.     gv = (GV*)POPs;
  679.     if (!gv)
  680.     gv = argvgv;
  681.     if (!gv || do_eof(gv)) /* make sure we have fp with something */
  682.     RETPUSHUNDEF;
  683.     TAINT_IF(1);
  684.     sv_setpv(TARG, " ");
  685.     *SvPVX(TARG) = getc(IoIFP(GvIOp(gv))); /* should never be EOF */
  686.     PUSHTARG;
  687.     RETURN;
  688. }
  689.  
  690. PP(pp_read)
  691. {
  692.     return pp_sysread(ARGS);
  693. }
  694.  
  695. static OP *
  696. doform(cv,gv,retop)
  697. CV *cv;
  698. GV *gv;
  699. OP *retop;
  700. {
  701.     register CONTEXT *cx;
  702.     I32 gimme = GIMME;
  703.     AV* padlist = CvPADLIST(cv);
  704.     SV** svp = AvARRAY(padlist);
  705.  
  706.     ENTER;
  707.     SAVETMPS;
  708.  
  709.     push_return(retop);
  710.     PUSHBLOCK(cx, CXt_SUB, stack_sp);
  711.     PUSHFORMAT(cx);
  712.     SAVESPTR(curpad);
  713.     curpad = AvARRAY((AV*)svp[1]);
  714.  
  715.     defoutgv = gv;        /* locally select filehandle so $% et al work */
  716.     return CvSTART(cv);
  717. }
  718.  
  719. PP(pp_enterwrite)
  720. {
  721.     dSP;
  722.     register GV *gv;
  723.     register IO *io;
  724.     GV *fgv;
  725.     CV *cv;
  726.  
  727.     if (MAXARG == 0)
  728.     gv = defoutgv;
  729.     else {
  730.     gv = (GV*)POPs;
  731.     if (!gv)
  732.         gv = defoutgv;
  733.     }
  734.     EXTEND(SP, 1);
  735.     io = GvIO(gv);
  736.     if (!io) {
  737.     RETPUSHNO;
  738.     }
  739.     if (IoFMT_GV(io))
  740.     fgv = IoFMT_GV(io);
  741.     else
  742.     fgv = gv;
  743.  
  744.     cv = GvFORM(fgv);
  745.  
  746.     if (!cv) {
  747.     if (fgv) {
  748.         SV *tmpstr = sv_newmortal();
  749.         gv_efullname(tmpstr, gv);
  750.         DIE("Undefined format \"%s\" called",SvPVX(tmpstr));
  751.     }
  752.     DIE("Not a format reference");
  753.     }
  754.  
  755.     return doform(cv,gv,op->op_next);
  756. }
  757.  
  758. PP(pp_leavewrite)
  759. {
  760.     dSP;
  761.     GV *gv = cxstack[cxstack_ix].blk_sub.gv;
  762.     register IO *io = GvIOp(gv);
  763.     FILE *ofp = IoOFP(io);
  764.     FILE *fp;
  765.     SV **newsp;
  766.     I32 gimme;
  767.     register CONTEXT *cx;
  768.  
  769.     DEBUG_f(fprintf(stderr,"left=%ld, todo=%ld\n",
  770.       (long)IoLINES_LEFT(io), (long)FmLINES(formtarget)));
  771.     if (IoLINES_LEFT(io) < FmLINES(formtarget) &&
  772.     formtarget != toptarget)
  773.     {
  774.     if (!IoTOP_GV(io)) {
  775.         GV *topgv;
  776.         char tmpbuf[256];
  777.  
  778.         if (!IoTOP_NAME(io)) {
  779.         if (!IoFMT_NAME(io))
  780.             IoFMT_NAME(io) = savepv(GvNAME(gv));
  781.         sprintf(tmpbuf, "%s_TOP", IoFMT_NAME(io));
  782.         topgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVFM);
  783.                 if ((topgv && GvFORM(topgv)) ||
  784.           !gv_fetchpv("top",FALSE,SVt_PVFM))
  785.             IoTOP_NAME(io) = savepv(tmpbuf);
  786.         else
  787.             IoTOP_NAME(io) = savepv("top");
  788.         }
  789.         topgv = gv_fetchpv(IoTOP_NAME(io),FALSE, SVt_PVFM);
  790.         if (!topgv || !GvFORM(topgv)) {
  791.         IoLINES_LEFT(io) = 100000000;
  792.         goto forget_top;
  793.         }
  794.         IoTOP_GV(io) = topgv;
  795.     }
  796.     if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0)
  797.         fwrite1(SvPVX(formfeed), SvCUR(formfeed), 1, ofp);
  798.     IoLINES_LEFT(io) = IoPAGE_LEN(io);
  799.     IoPAGE(io)++;
  800.     formtarget = toptarget;
  801.     return doform(GvFORM(IoTOP_GV(io)),gv,op);
  802.     }
  803.  
  804.   forget_top:
  805.     POPBLOCK(cx,curpm);
  806.     POPFORMAT(cx);
  807.     LEAVE;
  808.  
  809.     fp = IoOFP(io);
  810.     if (!fp) {
  811.     if (dowarn) {
  812.         if (IoIFP(io))
  813.         warn("Filehandle only opened for input");
  814.         else
  815.         warn("Write on closed filehandle");
  816.     }
  817.     PUSHs(&sv_no);
  818.     }
  819.     else {
  820.     if ((IoLINES_LEFT(io) -= FmLINES(formtarget)) < 0) {
  821.         if (dowarn)
  822.         warn("page overflow");
  823.     }
  824.     if (!fwrite1(SvPVX(formtarget), 1, SvCUR(formtarget), ofp) ||
  825.         ferror(fp))
  826.         PUSHs(&sv_no);
  827.     else {
  828.         FmLINES(formtarget) = 0;
  829.         SvCUR_set(formtarget, 0);
  830.         if (IoFLAGS(io) & IOf_FLUSH)
  831.         (void)fflush(fp);
  832.         PUSHs(&sv_yes);
  833.     }
  834.     }
  835.     formtarget = bodytarget;
  836.     PUTBACK;
  837.     return pop_return();
  838. }
  839.  
  840. PP(pp_prtf)
  841. {
  842.     dSP; dMARK; dORIGMARK;
  843.     GV *gv;
  844.     IO *io;
  845.     FILE *fp;
  846.     SV *sv = NEWSV(0,0);
  847.  
  848.     if (op->op_flags & OPf_STACKED)
  849.     gv = (GV*)*++MARK;
  850.     else
  851.     gv = defoutgv;
  852.     if (!(io = GvIO(gv))) {
  853.     if (dowarn)
  854.         warn("Filehandle %s never opened", GvNAME(gv));
  855.     errno = EBADF;
  856.     goto just_say_no;
  857.     }
  858.     else if (!(fp = IoOFP(io))) {
  859.     if (dowarn)  {
  860.         if (IoIFP(io))
  861.         warn("Filehandle %s opened only for input", GvNAME(gv));
  862.         else
  863.         warn("printf on closed filehandle %s", GvNAME(gv));
  864.     }
  865.     errno = EBADF;
  866.     goto just_say_no;
  867.     }
  868.     else {
  869.     do_sprintf(sv, SP - MARK, MARK + 1);
  870.     if (!do_print(sv, fp))
  871.         goto just_say_no;
  872.  
  873.     if (IoFLAGS(io) & IOf_FLUSH)
  874.         if (fflush(fp) == EOF)
  875.         goto just_say_no;
  876.     }
  877.     SvREFCNT_dec(sv);
  878.     SP = ORIGMARK;
  879.     PUSHs(&sv_yes);
  880.     RETURN;
  881.  
  882.   just_say_no:
  883.     SvREFCNT_dec(sv);
  884.     SP = ORIGMARK;
  885.     PUSHs(&sv_undef);
  886.     RETURN;
  887. }
  888.  
  889. PP(pp_sysread)
  890. {
  891.     dSP; dMARK; dORIGMARK; dTARGET;
  892.     int offset;
  893.     GV *gv;
  894.     IO *io;
  895.     char *buffer;
  896.     int length;
  897.     int bufsize;
  898.     SV *bufstr;
  899.     STRLEN blen;
  900.  
  901.     gv = (GV*)*++MARK;
  902.     if (!gv)
  903.     goto say_undef;
  904.     bufstr = *++MARK;
  905.     buffer = SvPV_force(bufstr, blen);
  906.     length = SvIVx(*++MARK);
  907.     if (length < 0)
  908.     DIE("Negative length");
  909.     errno = 0;
  910.     if (MARK < SP)
  911.     offset = SvIVx(*++MARK);
  912.     else
  913.     offset = 0;
  914.     io = GvIO(gv);
  915.     if (!io || !IoIFP(io))
  916.     goto say_undef;
  917. #ifdef HAS_SOCKET
  918.     if (op->op_type == OP_RECV) {
  919.     bufsize = sizeof buf;
  920.     buffer = SvGROW(bufstr, length+1);
  921.     length = recvfrom(fileno(IoIFP(io)), buffer, length, offset,
  922.         (struct sockaddr *)buf, &bufsize);
  923.     if (length < 0)
  924.         RETPUSHUNDEF;
  925.     SvCUR_set(bufstr, length);
  926.     *SvEND(bufstr) = '\0';
  927.     (void)SvPOK_only(bufstr);
  928.     SvSETMAGIC(bufstr);
  929.     if (tainting)
  930.         sv_magic(bufstr, Nullsv, 't', Nullch, 0);
  931.     SP = ORIGMARK;
  932.     sv_setpvn(TARG, buf, bufsize);
  933.     PUSHs(TARG);
  934.     RETURN;
  935.     }
  936. #else
  937.     if (op->op_type == OP_RECV)
  938.     DIE(no_sock_func, "recv");
  939. #endif
  940.     buffer = SvGROW(bufstr, length+offset+1);
  941.     if (op->op_type == OP_SYSREAD) {
  942.     length = read(fileno(IoIFP(io)), buffer+offset, length);
  943.     }
  944.     else
  945. #ifdef HAS_SOCKET__bad_code_maybe
  946.     if (IoTYPE(io) == 's') {
  947.     bufsize = sizeof buf;
  948.     length = recvfrom(fileno(IoIFP(io)), buffer+offset, length, 0,
  949.         (struct sockaddr *)buf, &bufsize);
  950.     }
  951.     else
  952. #endif
  953.     length = fread(buffer+offset, 1, length, IoIFP(io));
  954.     if (length < 0)
  955.     goto say_undef;
  956.     SvCUR_set(bufstr, length+offset);
  957.     *SvEND(bufstr) = '\0';
  958.     (void)SvPOK_only(bufstr);
  959.     SvSETMAGIC(bufstr);
  960.     if (tainting)
  961.     sv_magic(bufstr, Nullsv, 't', Nullch, 0);
  962.     SP = ORIGMARK;
  963.     PUSHi(length);
  964.     RETURN;
  965.  
  966.   say_undef:
  967.     SP = ORIGMARK;
  968.     RETPUSHUNDEF;
  969. }
  970.  
  971. PP(pp_syswrite)
  972. {
  973.     return pp_send(ARGS);
  974. }
  975.  
  976. PP(pp_send)
  977. {
  978.     dSP; dMARK; dORIGMARK; dTARGET;
  979.     GV *gv;
  980.     IO *io;
  981.     int offset;
  982.     SV *bufstr;
  983.     char *buffer;
  984.     int length;
  985.     STRLEN blen;
  986.  
  987.     gv = (GV*)*++MARK;
  988.     if (!gv)
  989.     goto say_undef;
  990.     bufstr = *++MARK;
  991.     buffer = SvPV(bufstr, blen);
  992.     length = SvIVx(*++MARK);
  993.     if (length < 0)
  994.     DIE("Negative length");
  995.     errno = 0;
  996.     io = GvIO(gv);
  997.     if (!io || !IoIFP(io)) {
  998.     length = -1;
  999.     if (dowarn) {
  1000.         if (op->op_type == OP_SYSWRITE)
  1001.         warn("Syswrite on closed filehandle");
  1002.         else
  1003.         warn("Send on closed socket");
  1004.     }
  1005.     }
  1006.     else if (op->op_type == OP_SYSWRITE) {
  1007.     if (MARK < SP)
  1008.         offset = SvIVx(*++MARK);
  1009.     else
  1010.         offset = 0;
  1011.     if (length > blen - offset)
  1012.         length = blen - offset;
  1013.     length = write(fileno(IoIFP(io)), buffer+offset, length);
  1014.     }
  1015. #ifdef HAS_SOCKET
  1016.     else if (SP > MARK) {
  1017.     char *sockbuf;
  1018.     STRLEN mlen;
  1019.     sockbuf = SvPVx(*++MARK, mlen);
  1020.     length = sendto(fileno(IoIFP(io)), buffer, blen, length,
  1021.                 (struct sockaddr *)sockbuf, mlen);
  1022.     }
  1023.     else
  1024.     length = send(fileno(IoIFP(io)), buffer, blen, length);
  1025. #else
  1026.     else
  1027.     DIE(no_sock_func, "send");
  1028. #endif
  1029.     if (length < 0)
  1030.     goto say_undef;
  1031.     SP = ORIGMARK;
  1032.     PUSHi(length);
  1033.     RETURN;
  1034.  
  1035.   say_undef:
  1036.     SP = ORIGMARK;
  1037.     RETPUSHUNDEF;
  1038. }
  1039.  
  1040. PP(pp_recv)
  1041. {
  1042.     return pp_sysread(ARGS);
  1043. }
  1044.  
  1045. PP(pp_eof)
  1046. {
  1047.     dSP;
  1048.     GV *gv;
  1049.  
  1050.     if (MAXARG <= 0)
  1051.     gv = last_in_gv;
  1052.     else
  1053.     gv = last_in_gv = (GV*)POPs;
  1054.     PUSHs(!gv || do_eof(gv) ? &sv_yes : &sv_no);
  1055.     RETURN;
  1056. }
  1057.  
  1058. PP(pp_tell)
  1059. {
  1060.     dSP; dTARGET;
  1061.     GV *gv;
  1062.  
  1063.     if (MAXARG <= 0)
  1064.     gv = last_in_gv;
  1065.     else
  1066.     gv = last_in_gv = (GV*)POPs;
  1067.     PUSHi( do_tell(gv) );
  1068.     RETURN;
  1069. }
  1070.  
  1071. PP(pp_seek)
  1072. {
  1073.     dSP;
  1074.     GV *gv;
  1075.     int whence = POPi;
  1076.     long offset = POPl;
  1077.  
  1078.     gv = last_in_gv = (GV*)POPs;
  1079.     PUSHs( do_seek(gv, offset, whence) ? &sv_yes : &sv_no );
  1080.     RETURN;
  1081. }
  1082.  
  1083. PP(pp_truncate)
  1084. {
  1085.     dSP;
  1086.     Off_t len = (Off_t)POPn;
  1087.     int result = 1;
  1088.     GV *tmpgv;
  1089.  
  1090.     errno = 0;
  1091. #if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE)
  1092. #ifdef HAS_TRUNCATE
  1093.     if (op->op_flags & OPf_SPECIAL) {
  1094.     tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
  1095.     if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
  1096.       ftruncate(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
  1097.         result = 0;
  1098.     }
  1099.     else if (truncate(POPp, len) < 0)
  1100.     result = 0;
  1101. #else
  1102.     if (op->op_flags & OPf_SPECIAL) {
  1103.     tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
  1104.     if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
  1105.       chsize(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
  1106.         result = 0;
  1107.     }
  1108.     else {
  1109.     int tmpfd;
  1110.  
  1111.     if ((tmpfd = open(POPp, 0)) < 0)
  1112.         result = 0;
  1113.     else {
  1114.         if (chsize(tmpfd, len) < 0)
  1115.         result = 0;
  1116.         close(tmpfd);
  1117.     }
  1118.     }
  1119. #endif
  1120.  
  1121.     if (result)
  1122.     RETPUSHYES;
  1123.     if (!errno)
  1124.     errno = EBADF;
  1125.     RETPUSHUNDEF;
  1126. #else
  1127.     DIE("truncate not implemented");
  1128. #endif
  1129. }
  1130.  
  1131. PP(pp_fcntl)
  1132. {
  1133.     return pp_ioctl(ARGS);
  1134. }
  1135.  
  1136. PP(pp_ioctl)
  1137. {
  1138.     dSP; dTARGET;
  1139.     SV *argstr = POPs;
  1140.     unsigned int func = U_I(POPn);
  1141.     int optype = op->op_type;
  1142.     char *s;
  1143.     int retval;
  1144.     GV *gv = (GV*)POPs;
  1145.     IO *io = GvIOn(gv);
  1146.  
  1147.     if (!io || !argstr || !IoIFP(io)) {
  1148.     errno = EBADF;    /* well, sort of... */
  1149.     RETPUSHUNDEF;
  1150.     }
  1151.  
  1152.     if (SvPOK(argstr) || !SvNIOK(argstr)) {
  1153.     STRLEN len;
  1154.     s = SvPV_force(argstr, len);
  1155.     retval = IOCPARM_LEN(func);
  1156.     if (len < retval) {
  1157.         s = Sv_Grow(argstr, retval+1);
  1158.         SvCUR_set(argstr, retval);
  1159.     }
  1160.  
  1161.     s[SvCUR(argstr)] = 17;    /* a little sanity check here */
  1162.     }
  1163.     else {
  1164.     retval = SvIV(argstr);
  1165. #ifdef DOSISH
  1166.     s = (char*)(long)retval;    /* ouch */
  1167. #else
  1168.     s = (char*)retval;        /* ouch */
  1169. #endif
  1170.     }
  1171.  
  1172.     TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl");
  1173.  
  1174.     if (optype == OP_IOCTL)
  1175. #ifdef HAS_IOCTL
  1176.     retval = ioctl(fileno(IoIFP(io)), func, s);
  1177. #else
  1178.     DIE("ioctl is not implemented");
  1179. #endif
  1180.     else
  1181. #ifdef DOSISH
  1182.     DIE("fcntl is not implemented");
  1183. #else
  1184. #   ifdef HAS_FCNTL
  1185.     retval = fcntl(fileno(IoIFP(io)), func, s);
  1186. #   else
  1187.     DIE("fcntl is not implemented");
  1188. #   endif
  1189. #endif
  1190.  
  1191.     if (SvPOK(argstr)) {
  1192.     if (s[SvCUR(argstr)] != 17)
  1193.         DIE("Possible memory corruption: %s overflowed 3rd argument",
  1194.         op_name[optype]);
  1195.     s[SvCUR(argstr)] = 0;        /* put our null back */
  1196.     SvSETMAGIC(argstr);        /* Assume it has changed */
  1197.     }
  1198.  
  1199.     if (retval == -1)
  1200.     RETPUSHUNDEF;
  1201.     if (retval != 0) {
  1202.     PUSHi(retval);
  1203.     }
  1204.     else {
  1205.     PUSHp("0 but true", 10);
  1206.     }
  1207.     RETURN;
  1208. }
  1209.  
  1210. PP(pp_flock)
  1211. {
  1212.     dSP; dTARGET;
  1213.     I32 value;
  1214.     int argtype;
  1215.     GV *gv;
  1216.     FILE *fp;
  1217. #ifdef HAS_FLOCK
  1218.     argtype = POPi;
  1219.     if (MAXARG <= 0)
  1220.     gv = last_in_gv;
  1221.     else
  1222.     gv = (GV*)POPs;
  1223.     if (gv && GvIO(gv))
  1224.     fp = IoIFP(GvIOp(gv));
  1225.     else
  1226.     fp = Nullfp;
  1227.     if (fp) {
  1228.     value = (I32)(flock(fileno(fp), argtype) >= 0);
  1229.     }
  1230.     else
  1231.     value = 0;
  1232.     PUSHi(value);
  1233.     RETURN;
  1234. #else
  1235. # ifdef HAS_LOCKF
  1236.     DIE(no_func, "flock()"); /* XXX emulate flock() with lockf()? */
  1237. # else
  1238.     DIE(no_func, "flock()");
  1239. # endif
  1240. #endif
  1241. }
  1242.  
  1243. /* Sockets. */
  1244.  
  1245. PP(pp_socket)
  1246. {
  1247.     dSP;
  1248. #ifdef HAS_SOCKET
  1249.     GV *gv;
  1250.     register IO *io;
  1251.     int protocol = POPi;
  1252.     int type = POPi;
  1253.     int domain = POPi;
  1254.     int fd;
  1255.  
  1256.     gv = (GV*)POPs;
  1257.  
  1258.     if (!gv) {
  1259.     errno = EBADF;
  1260.     RETPUSHUNDEF;
  1261.     }
  1262.  
  1263.     io = GvIOn(gv);
  1264.     if (IoIFP(io))
  1265.     do_close(gv, FALSE);
  1266.  
  1267.     TAINT_PROPER("socket");
  1268.     fd = socket(domain, type, protocol);
  1269.     if (fd < 0)
  1270.     RETPUSHUNDEF;
  1271.     IoIFP(io) = fdopen(fd, "r");    /* stdio gets confused about sockets */
  1272.     IoOFP(io) = fdopen(fd, "w");
  1273.     IoTYPE(io) = 's';
  1274.     if (!IoIFP(io) || !IoOFP(io)) {
  1275.     if (IoIFP(io)) fclose(IoIFP(io));
  1276.     if (IoOFP(io)) fclose(IoOFP(io));
  1277.     if (!IoIFP(io) && !IoOFP(io)) close(fd);
  1278.     RETPUSHUNDEF;
  1279.     }
  1280.  
  1281.     RETPUSHYES;
  1282. #else
  1283.     DIE(no_sock_func, "socket");
  1284. #endif
  1285. }
  1286.  
  1287. PP(pp_sockpair)
  1288. {
  1289.     dSP;
  1290. #ifdef HAS_SOCKETPAIR
  1291.     GV *gv1;
  1292.     GV *gv2;
  1293.     register IO *io1;
  1294.     register IO *io2;
  1295.     int protocol = POPi;
  1296.     int type = POPi;
  1297.     int domain = POPi;
  1298.     int fd[2];
  1299.  
  1300.     gv2 = (GV*)POPs;
  1301.     gv1 = (GV*)POPs;
  1302.     if (!gv1 || !gv2)
  1303.     RETPUSHUNDEF;
  1304.  
  1305.     io1 = GvIOn(gv1);
  1306.     io2 = GvIOn(gv2);
  1307.     if (IoIFP(io1))
  1308.     do_close(gv1, FALSE);
  1309.     if (IoIFP(io2))
  1310.     do_close(gv2, FALSE);
  1311.  
  1312.     TAINT_PROPER("socketpair");
  1313.     if (socketpair(domain, type, protocol, fd) < 0)
  1314.     RETPUSHUNDEF;
  1315.     IoIFP(io1) = fdopen(fd[0], "r");
  1316.     IoOFP(io1) = fdopen(fd[0], "w");
  1317.     IoTYPE(io1) = 's';
  1318.     IoIFP(io2) = fdopen(fd[1], "r");
  1319.     IoOFP(io2) = fdopen(fd[1], "w");
  1320.     IoTYPE(io2) = 's';
  1321.     if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
  1322.     if (IoIFP(io1)) fclose(IoIFP(io1));
  1323.     if (IoOFP(io1)) fclose(IoOFP(io1));
  1324.     if (!IoIFP(io1) && !IoOFP(io1)) close(fd[0]);
  1325.     if (IoIFP(io2)) fclose(IoIFP(io2));
  1326.     if (IoOFP(io2)) fclose(IoOFP(io2));
  1327.     if (!IoIFP(io2) && !IoOFP(io2)) close(fd[1]);
  1328.     RETPUSHUNDEF;
  1329.     }
  1330.  
  1331.     RETPUSHYES;
  1332. #else
  1333.     DIE(no_sock_func, "socketpair");
  1334. #endif
  1335. }
  1336.  
  1337. PP(pp_bind)
  1338. {
  1339.     dSP;
  1340. #ifdef HAS_SOCKET
  1341.     SV *addrstr = POPs;
  1342.     char *addr;
  1343.     GV *gv = (GV*)POPs;
  1344.     register IO *io = GvIOn(gv);
  1345.     STRLEN len;
  1346.  
  1347.     if (!io || !IoIFP(io))
  1348.     goto nuts;
  1349.  
  1350.     addr = SvPV(addrstr, len);
  1351.     TAINT_PROPER("bind");
  1352.     if (bind(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
  1353.     RETPUSHYES;
  1354.     else
  1355.     RETPUSHUNDEF;
  1356.  
  1357. nuts:
  1358.     if (dowarn)
  1359.     warn("bind() on closed fd");
  1360.     errno = EBADF;
  1361.     RETPUSHUNDEF;
  1362. #else
  1363.     DIE(no_sock_func, "bind");
  1364. #endif
  1365. }
  1366.  
  1367. PP(pp_connect)
  1368. {
  1369.     dSP;
  1370. #ifdef HAS_SOCKET
  1371.     SV *addrstr = POPs;
  1372.     char *addr;
  1373.     GV *gv = (GV*)POPs;
  1374.     register IO *io = GvIOn(gv);
  1375.     STRLEN len;
  1376.  
  1377.     if (!io || !IoIFP(io))
  1378.     goto nuts;
  1379.  
  1380.     addr = SvPV(addrstr, len);
  1381.     TAINT_PROPER("connect");
  1382.     if (connect(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
  1383.     RETPUSHYES;
  1384.     else
  1385.     RETPUSHUNDEF;
  1386.  
  1387. nuts:
  1388.     if (dowarn)
  1389.     warn("connect() on closed fd");
  1390.     errno = EBADF;
  1391.     RETPUSHUNDEF;
  1392. #else
  1393.     DIE(no_sock_func, "connect");
  1394. #endif
  1395. }
  1396.  
  1397. PP(pp_listen)
  1398. {
  1399.     dSP;
  1400. #ifdef HAS_SOCKET
  1401.     int backlog = POPi;
  1402.     GV *gv = (GV*)POPs;
  1403.     register IO *io = GvIOn(gv);
  1404.  
  1405.     if (!io || !IoIFP(io))
  1406.     goto nuts;
  1407.  
  1408.     if (listen(fileno(IoIFP(io)), backlog) >= 0)
  1409.     RETPUSHYES;
  1410.     else
  1411.     RETPUSHUNDEF;
  1412.  
  1413. nuts:
  1414.     if (dowarn)
  1415.     warn("listen() on closed fd");
  1416.     errno = EBADF;
  1417.     RETPUSHUNDEF;
  1418. #else
  1419.     DIE(no_sock_func, "listen");
  1420. #endif
  1421. }
  1422.  
  1423. PP(pp_accept)
  1424. {
  1425.     dSP; dTARGET;
  1426. #ifdef HAS_SOCKET
  1427.     GV *ngv;
  1428.     GV *ggv;
  1429.     register IO *nstio;
  1430.     register IO *gstio;
  1431.     int len = sizeof buf;
  1432.     int fd;
  1433.  
  1434.     ggv = (GV*)POPs;
  1435.     ngv = (GV*)POPs;
  1436.  
  1437.     if (!ngv)
  1438.     goto badexit;
  1439.     if (!ggv)
  1440.     goto nuts;
  1441.  
  1442.     gstio = GvIO(ggv);
  1443.     if (!gstio || !IoIFP(gstio))
  1444.     goto nuts;
  1445.  
  1446.     nstio = GvIOn(ngv);
  1447.     if (IoIFP(nstio))
  1448.     do_close(ngv, FALSE);
  1449.  
  1450.     fd = accept(fileno(IoIFP(gstio)), (struct sockaddr *)buf, &len);
  1451.     if (fd < 0)
  1452.     goto badexit;
  1453.     IoIFP(nstio) = fdopen(fd, "r");
  1454.     IoOFP(nstio) = fdopen(fd, "w");
  1455.     IoTYPE(nstio) = 's';
  1456.     if (!IoIFP(nstio) || !IoOFP(nstio)) {
  1457.     if (IoIFP(nstio)) fclose(IoIFP(nstio));
  1458.     if (IoOFP(nstio)) fclose(IoOFP(nstio));
  1459.     if (!IoIFP(nstio) && !IoOFP(nstio)) close(fd);
  1460.     goto badexit;
  1461.     }
  1462.  
  1463.     PUSHp(buf, len);
  1464.     RETURN;
  1465.  
  1466. nuts:
  1467.     if (dowarn)
  1468.     warn("accept() on closed fd");
  1469.     errno = EBADF;
  1470.  
  1471. badexit:
  1472.     RETPUSHUNDEF;
  1473.  
  1474. #else
  1475.     DIE(no_sock_func, "accept");
  1476. #endif
  1477. }
  1478.  
  1479. PP(pp_shutdown)
  1480. {
  1481.     dSP; dTARGET;
  1482. #ifdef HAS_SOCKET
  1483.     int how = POPi;
  1484.     GV *gv = (GV*)POPs;
  1485.     register IO *io = GvIOn(gv);
  1486.  
  1487.     if (!io || !IoIFP(io))
  1488.     goto nuts;
  1489.  
  1490.     PUSHi( shutdown(fileno(IoIFP(io)), how) >= 0 );
  1491.     RETURN;
  1492.  
  1493. nuts:
  1494.     if (dowarn)
  1495.     warn("shutdown() on closed fd");
  1496.     errno = EBADF;
  1497.     RETPUSHUNDEF;
  1498. #else
  1499.     DIE(no_sock_func, "shutdown");
  1500. #endif
  1501. }
  1502.  
  1503. PP(pp_gsockopt)
  1504. {
  1505. #ifdef HAS_SOCKET
  1506.     return pp_ssockopt(ARGS);
  1507. #else
  1508.     DIE(no_sock_func, "getsockopt");
  1509. #endif
  1510. }
  1511.  
  1512. PP(pp_ssockopt)
  1513. {
  1514.     dSP;
  1515. #ifdef HAS_SOCKET
  1516.     int optype = op->op_type;
  1517.     SV *sv;
  1518.     int fd;
  1519.     unsigned int optname;
  1520.     unsigned int lvl;
  1521.     GV *gv;
  1522.     register IO *io;
  1523.  
  1524.     if (optype == OP_GSOCKOPT)
  1525.     sv = sv_2mortal(NEWSV(22, 257));
  1526.     else
  1527.     sv = POPs;
  1528.     optname = (unsigned int) POPi;
  1529.     lvl = (unsigned int) POPi;
  1530.  
  1531.     gv = (GV*)POPs;
  1532.     io = GvIOn(gv);
  1533.     if (!io || !IoIFP(io))
  1534.     goto nuts;
  1535.  
  1536.     fd = fileno(IoIFP(io));
  1537.     switch (optype) {
  1538.     case OP_GSOCKOPT:
  1539.     SvGROW(sv, 256);
  1540.     (void)SvPOK_only(sv);
  1541.     if (getsockopt(fd, lvl, optname, SvPVX(sv), (int*)&SvCUR(sv)) < 0)
  1542.         goto nuts2;
  1543.     PUSHs(sv);
  1544.     break;
  1545.     case OP_SSOCKOPT: {
  1546.         int aint;
  1547.         STRLEN len = 0;
  1548.         char *buf = 0;
  1549.         if (SvPOKp(sv))
  1550.         buf = SvPV(sv, len);
  1551.         else if (SvOK(sv)) {
  1552.         aint = (int)SvIV(sv);
  1553.         buf = (char*)&aint;
  1554.         len = sizeof(int);
  1555.         }
  1556.         if (setsockopt(fd, lvl, optname, buf, (int)len) < 0)
  1557.         goto nuts2;
  1558.         PUSHs(&sv_yes);
  1559.     }
  1560.     break;
  1561.     }
  1562.     RETURN;
  1563.  
  1564. nuts:
  1565.     if (dowarn)
  1566.     warn("[gs]etsockopt() on closed fd");
  1567.     errno = EBADF;
  1568. nuts2:
  1569.     RETPUSHUNDEF;
  1570.  
  1571. #else
  1572.     DIE(no_sock_func, "setsockopt");
  1573. #endif
  1574. }
  1575.  
  1576. PP(pp_getsockname)
  1577. {
  1578. #ifdef HAS_SOCKET
  1579.     return pp_getpeername(ARGS);
  1580. #else
  1581.     DIE(no_sock_func, "getsockname");
  1582. #endif
  1583. }
  1584.  
  1585. PP(pp_getpeername)
  1586. {
  1587.     dSP;
  1588. #ifdef HAS_SOCKET
  1589.     int optype = op->op_type;
  1590.     SV *sv;
  1591.     int fd;
  1592.     GV *gv = (GV*)POPs;
  1593.     register IO *io = GvIOn(gv);
  1594.  
  1595.     if (!io || !IoIFP(io))
  1596.     goto nuts;
  1597.  
  1598.     sv = sv_2mortal(NEWSV(22, 257));
  1599.     SvCUR_set(sv, 256);
  1600.     SvPOK_on(sv);
  1601.     fd = fileno(IoIFP(io));
  1602.     switch (optype) {
  1603.     case OP_GETSOCKNAME:
  1604.     if (getsockname(fd, (struct sockaddr *)SvPVX(sv), (int*)&SvCUR(sv)) < 0)
  1605.         goto nuts2;
  1606.     break;
  1607.     case OP_GETPEERNAME:
  1608.     if (getpeername(fd, (struct sockaddr *)SvPVX(sv), (int*)&SvCUR(sv)) < 0)
  1609.         goto nuts2;
  1610.     break;
  1611.     }
  1612.     PUSHs(sv);
  1613.     RETURN;
  1614.  
  1615. nuts:
  1616.     if (dowarn)
  1617.     warn("get{sock, peer}name() on closed fd");
  1618.     errno = EBADF;
  1619. nuts2:
  1620.     RETPUSHUNDEF;
  1621.  
  1622. #else
  1623.     DIE(no_sock_func, "getpeername");
  1624. #endif
  1625. }
  1626.  
  1627. /* Stat calls. */
  1628.  
  1629. PP(pp_lstat)
  1630. {
  1631.     return pp_stat(ARGS);
  1632. }
  1633.  
  1634. PP(pp_stat)
  1635. {
  1636.     dSP;
  1637.     GV *tmpgv;
  1638.     I32 max = 13;
  1639.  
  1640.     if (op->op_flags & OPf_REF) {
  1641.     tmpgv = cGVOP->op_gv;
  1642.     if (tmpgv != defgv) {
  1643.         laststype = OP_STAT;
  1644.         statgv = tmpgv;
  1645.         sv_setpv(statname, "");
  1646.         if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
  1647.           Fstat(fileno(IoIFP(GvIOn(tmpgv))), &statcache) < 0) {
  1648.         max = 0;
  1649.         laststatval = -1;
  1650.         }
  1651.     }
  1652.     else if (laststatval < 0)
  1653.         max = 0;
  1654.     }
  1655.     else {
  1656.     sv_setpv(statname, POPp);
  1657.     statgv = Nullgv;
  1658. #ifdef HAS_LSTAT
  1659.     laststype = op->op_type;
  1660.     if (op->op_type == OP_LSTAT)
  1661.         laststatval = lstat(SvPV(statname, na), &statcache);
  1662.     else
  1663. #endif
  1664.         laststatval = Stat(SvPV(statname, na), &statcache);
  1665.     if (laststatval < 0) {
  1666.         if (dowarn && strchr(SvPV(statname, na), '\n'))
  1667.         warn(warn_nl, "stat");
  1668.         max = 0;
  1669.     }
  1670.     }
  1671.  
  1672.     EXTEND(SP, 13);
  1673.     if (GIMME != G_ARRAY) {
  1674.     if (max)
  1675.         RETPUSHYES;
  1676.     else
  1677.         RETPUSHUNDEF;
  1678.     }
  1679.     if (max) {
  1680.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_dev)));
  1681.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_ino)));
  1682.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_mode)));
  1683.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_nlink)));
  1684.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_uid)));
  1685.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_gid)));
  1686.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_rdev)));
  1687.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_size)));
  1688.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_atime)));
  1689.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_mtime)));
  1690.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_ctime)));
  1691. #ifdef USE_STAT_BLOCKS
  1692.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_blksize)));
  1693.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_blocks)));
  1694. #else
  1695.     PUSHs(sv_2mortal(newSVpv("", 0)));
  1696.     PUSHs(sv_2mortal(newSVpv("", 0)));
  1697. #endif
  1698.     }
  1699.     RETURN;
  1700. }
  1701.  
  1702. PP(pp_ftrread)
  1703. {
  1704.     I32 result = my_stat(ARGS);
  1705.     dSP;
  1706.     if (result < 0)
  1707.     RETPUSHUNDEF;
  1708.     if (cando(S_IRUSR, 0, &statcache))
  1709.     RETPUSHYES;
  1710.     RETPUSHNO;
  1711. }
  1712.  
  1713. PP(pp_ftrwrite)
  1714. {
  1715.     I32 result = my_stat(ARGS);
  1716.     dSP;
  1717.     if (result < 0)
  1718.     RETPUSHUNDEF;
  1719.     if (cando(S_IWUSR, 0, &statcache))
  1720.     RETPUSHYES;
  1721.     RETPUSHNO;
  1722. }
  1723.  
  1724. PP(pp_ftrexec)
  1725. {
  1726.     I32 result = my_stat(ARGS);
  1727.     dSP;
  1728.     if (result < 0)
  1729.     RETPUSHUNDEF;
  1730.     if (cando(S_IXUSR, 0, &statcache))
  1731.     RETPUSHYES;
  1732.     RETPUSHNO;
  1733. }
  1734.  
  1735. PP(pp_fteread)
  1736. {
  1737.     I32 result = my_stat(ARGS);
  1738.     dSP;
  1739.     if (result < 0)
  1740.     RETPUSHUNDEF;
  1741.     if (cando(S_IRUSR, 1, &statcache))
  1742.     RETPUSHYES;
  1743.     RETPUSHNO;
  1744. }
  1745.  
  1746. PP(pp_ftewrite)
  1747. {
  1748.     I32 result = my_stat(ARGS);
  1749.     dSP;
  1750.     if (result < 0)
  1751.     RETPUSHUNDEF;
  1752.     if (cando(S_IWUSR, 1, &statcache))
  1753.     RETPUSHYES;
  1754.     RETPUSHNO;
  1755. }
  1756.  
  1757. PP(pp_fteexec)
  1758. {
  1759.     I32 result = my_stat(ARGS);
  1760.     dSP;
  1761.     if (result < 0)
  1762.     RETPUSHUNDEF;
  1763.     if (cando(S_IXUSR, 1, &statcache))
  1764.     RETPUSHYES;
  1765.     RETPUSHNO;
  1766. }
  1767.  
  1768. PP(pp_ftis)
  1769. {
  1770.     I32 result = my_stat(ARGS);
  1771.     dSP;
  1772.     if (result < 0)
  1773.     RETPUSHUNDEF;
  1774.     RETPUSHYES;
  1775. }
  1776.  
  1777. PP(pp_fteowned)
  1778. {
  1779.     return pp_ftrowned(ARGS);
  1780. }
  1781.  
  1782. PP(pp_ftrowned)
  1783. {
  1784.     I32 result = my_stat(ARGS);
  1785.     dSP;
  1786.     if (result < 0)
  1787.     RETPUSHUNDEF;
  1788.     if (statcache.st_uid == (op->op_type == OP_FTEOWNED ? euid : uid) )
  1789.     RETPUSHYES;
  1790.     RETPUSHNO;
  1791. }
  1792.  
  1793. PP(pp_ftzero)
  1794. {
  1795.     I32 result = my_stat(ARGS);
  1796.     dSP;
  1797.     if (result < 0)
  1798.     RETPUSHUNDEF;
  1799.     if (!statcache.st_size)
  1800.     RETPUSHYES;
  1801.     RETPUSHNO;
  1802. }
  1803.  
  1804. PP(pp_ftsize)
  1805. {
  1806.     I32 result = my_stat(ARGS);
  1807.     dSP; dTARGET;
  1808.     if (result < 0)
  1809.     RETPUSHUNDEF;
  1810.     PUSHi(statcache.st_size);
  1811.     RETURN;
  1812. }
  1813.  
  1814. PP(pp_ftmtime)
  1815. {
  1816.     I32 result = my_stat(ARGS);
  1817.     dSP; dTARGET;
  1818.     if (result < 0)
  1819.     RETPUSHUNDEF;
  1820.     PUSHn( (basetime - statcache.st_mtime) / 86400.0 );
  1821.     RETURN;
  1822. }
  1823.  
  1824. PP(pp_ftatime)
  1825. {
  1826.     I32 result = my_stat(ARGS);
  1827.     dSP; dTARGET;
  1828.     if (result < 0)
  1829.     RETPUSHUNDEF;
  1830.     PUSHn( (basetime - statcache.st_atime) / 86400.0 );
  1831.     RETURN;
  1832. }
  1833.  
  1834. PP(pp_ftctime)
  1835. {
  1836.     I32 result = my_stat(ARGS);
  1837.     dSP; dTARGET;
  1838.     if (result < 0)
  1839.     RETPUSHUNDEF;
  1840.     PUSHn( (basetime - statcache.st_ctime) / 86400.0 );
  1841.     RETURN;
  1842. }
  1843.  
  1844. PP(pp_ftsock)
  1845. {
  1846.     I32 result = my_stat(ARGS);
  1847.     dSP;
  1848.     if (result < 0)
  1849.     RETPUSHUNDEF;
  1850.     if (S_ISSOCK(statcache.st_mode))
  1851.     RETPUSHYES;
  1852.     RETPUSHNO;
  1853. }
  1854.  
  1855. PP(pp_ftchr)
  1856. {
  1857.     I32 result = my_stat(ARGS);
  1858.     dSP;
  1859.     if (result < 0)
  1860.     RETPUSHUNDEF;
  1861.     if (S_ISCHR(statcache.st_mode))
  1862.     RETPUSHYES;
  1863.     RETPUSHNO;
  1864. }
  1865.  
  1866. PP(pp_ftblk)
  1867. {
  1868.     I32 result = my_stat(ARGS);
  1869.     dSP;
  1870.     if (result < 0)
  1871.     RETPUSHUNDEF;
  1872.     if (S_ISBLK(statcache.st_mode))
  1873.     RETPUSHYES;
  1874.     RETPUSHNO;
  1875. }
  1876.  
  1877. PP(pp_ftfile)
  1878. {
  1879.     I32 result = my_stat(ARGS);
  1880.     dSP;
  1881.     if (result < 0)
  1882.     RETPUSHUNDEF;
  1883.     if (S_ISREG(statcache.st_mode))
  1884.     RETPUSHYES;
  1885.     RETPUSHNO;
  1886. }
  1887.  
  1888. PP(pp_ftdir)
  1889. {
  1890.     I32 result = my_stat(ARGS);
  1891.     dSP;
  1892.     if (result < 0)
  1893.     RETPUSHUNDEF;
  1894.     if (S_ISDIR(statcache.st_mode))
  1895.     RETPUSHYES;
  1896.     RETPUSHNO;
  1897. }
  1898.  
  1899. PP(pp_ftpipe)
  1900. {
  1901.     I32 result = my_stat(ARGS);
  1902.     dSP;
  1903.     if (result < 0)
  1904.     RETPUSHUNDEF;
  1905.     if (S_ISFIFO(statcache.st_mode))
  1906.     RETPUSHYES;
  1907.     RETPUSHNO;
  1908. }
  1909.  
  1910. PP(pp_ftlink)
  1911. {
  1912.     I32 result = my_lstat(ARGS);
  1913.     dSP;
  1914.     if (result < 0)
  1915.     RETPUSHUNDEF;
  1916.     if (S_ISLNK(statcache.st_mode))
  1917.     RETPUSHYES;
  1918.     RETPUSHNO;
  1919. }
  1920.  
  1921. PP(pp_ftsuid)
  1922. {
  1923.     dSP;
  1924. #ifdef S_ISUID
  1925.     I32 result = my_stat(ARGS);
  1926.     SPAGAIN;
  1927.     if (result < 0)
  1928.     RETPUSHUNDEF;
  1929.     if (statcache.st_mode & S_ISUID)
  1930.     RETPUSHYES;
  1931. #endif
  1932.     RETPUSHNO;
  1933. }
  1934.  
  1935. PP(pp_ftsgid)
  1936. {
  1937.     dSP;
  1938. #ifdef S_ISGID
  1939.     I32 result = my_stat(ARGS);
  1940.     SPAGAIN;
  1941.     if (result < 0)
  1942.     RETPUSHUNDEF;
  1943.     if (statcache.st_mode & S_ISGID)
  1944.     RETPUSHYES;
  1945. #endif
  1946.     RETPUSHNO;
  1947. }
  1948.  
  1949. PP(pp_ftsvtx)
  1950. {
  1951.     dSP;
  1952. #ifdef S_ISVTX
  1953.     I32 result = my_stat(ARGS);
  1954.     SPAGAIN;
  1955.     if (result < 0)
  1956.     RETPUSHUNDEF;
  1957.     if (statcache.st_mode & S_ISVTX)
  1958.     RETPUSHYES;
  1959. #endif
  1960.     RETPUSHNO;
  1961. }
  1962.  
  1963. PP(pp_fttty)
  1964. {
  1965.     dSP;
  1966.     int fd;
  1967.     GV *gv;
  1968.     char *tmps;
  1969.     if (op->op_flags & OPf_REF) {
  1970.     gv = cGVOP->op_gv;
  1971.     tmps = "";
  1972.     }
  1973.     else
  1974.     gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO);
  1975.     if (GvIO(gv) && IoIFP(GvIOp(gv)))
  1976.     fd = fileno(IoIFP(GvIOp(gv)));
  1977.     else if (isDIGIT(*tmps))
  1978.     fd = atoi(tmps);
  1979.     else
  1980.     RETPUSHUNDEF;
  1981.     if (isatty(fd))
  1982.     RETPUSHYES;
  1983.     RETPUSHNO;
  1984. }
  1985.  
  1986. #if defined(USE_STD_STDIO) || defined(atarist) /* this will work with atariST */
  1987. # define FBASE(f) ((f)->_base)
  1988. # define FSIZE(f) ((f)->_cnt + ((f)->_ptr - (f)->_base))
  1989. # define FPTR(f) ((f)->_ptr)
  1990. # define FCOUNT(f) ((f)->_cnt)
  1991. #else 
  1992. # if defined(USE_LINUX_STDIO)
  1993. #   define FBASE(f) ((f)->_IO_read_base)
  1994. #   define FSIZE(f) ((f)->_IO_read_end - FBASE(f))
  1995. #   define FPTR(f) ((f)->_IO_read_ptr)
  1996. #   define FCOUNT(f) ((f)->_IO_read_end - FPTR(f))
  1997. # endif
  1998. #endif
  1999.  
  2000. PP(pp_fttext)
  2001. {
  2002.     dSP;
  2003.     I32 i;
  2004.     I32 len;
  2005.     I32 odd = 0;
  2006.     STDCHAR tbuf[512];
  2007.     register STDCHAR *s;
  2008.     register IO *io;
  2009.     SV *sv;
  2010.  
  2011.     if (op->op_flags & OPf_REF) {
  2012.     EXTEND(SP, 1);
  2013.     if (cGVOP->op_gv == defgv) {
  2014.         if (statgv)
  2015.         io = GvIO(statgv);
  2016.         else {
  2017.         sv = statname;
  2018.         goto really_filename;
  2019.         }
  2020.     }
  2021.     else {
  2022.         statgv = cGVOP->op_gv;
  2023.         sv_setpv(statname, "");
  2024.         io = GvIO(statgv);
  2025.     }
  2026.     if (io && IoIFP(io)) {
  2027. #ifdef FBASE
  2028.         Fstat(fileno(IoIFP(io)), &statcache);
  2029.         if (S_ISDIR(statcache.st_mode))    /* handle NFS glitch */
  2030.         if (op->op_type == OP_FTTEXT)
  2031.             RETPUSHNO;
  2032.         else
  2033.             RETPUSHYES;
  2034.         if (FCOUNT(IoIFP(io)) <= 0) {
  2035.         i = getc(IoIFP(io));
  2036.         if (i != EOF)
  2037.             (void)ungetc(i, IoIFP(io));
  2038.         }
  2039.         if (FCOUNT(IoIFP(io)) <= 0)    /* null file is anything */
  2040.         RETPUSHYES;
  2041.         len = FSIZE(IoIFP(io));
  2042.         s = FBASE(IoIFP(io));
  2043. #else
  2044.         DIE("-T and -B not implemented on filehandles");
  2045. #endif
  2046.     }
  2047.     else {
  2048.         if (dowarn)
  2049.         warn("Test on unopened file <%s>",
  2050.           GvENAME(cGVOP->op_gv));
  2051.         errno = EBADF;
  2052.         RETPUSHUNDEF;
  2053.     }
  2054.     }
  2055.     else {
  2056.     sv = POPs;
  2057.     statgv = Nullgv;
  2058.     sv_setpv(statname, SvPV(sv, na));
  2059.       really_filename:
  2060. #ifdef HAS_OPEN3
  2061.     i = open(SvPV(sv, na), O_RDONLY, 0);
  2062. #else
  2063.     i = open(SvPV(sv, na), 0);
  2064. #endif
  2065.     if (i < 0) {
  2066.         if (dowarn && strchr(SvPV(sv, na), '\n'))
  2067.         warn(warn_nl, "open");
  2068.         RETPUSHUNDEF;
  2069.     }
  2070.     Fstat(i, &statcache);
  2071.     len = read(i, tbuf, 512);
  2072.     (void)close(i);
  2073.     if (len <= 0) {
  2074.         if (S_ISDIR(statcache.st_mode) && op->op_type == OP_FTTEXT)
  2075.         RETPUSHNO;        /* special case NFS directories */
  2076.         RETPUSHYES;        /* null file is anything */
  2077.     }
  2078.     s = tbuf;
  2079.     }
  2080.  
  2081.     /* now scan s to look for textiness */
  2082.  
  2083.     for (i = 0; i < len; i++, s++) {
  2084.     if (!*s) {            /* null never allowed in text */
  2085.         odd += len;
  2086.         break;
  2087.     }
  2088.     else if (*s & 128)
  2089.         odd++;
  2090.     else if (*s < 32 &&
  2091.       *s != '\n' && *s != '\r' && *s != '\b' &&
  2092.       *s != '\t' && *s != '\f' && *s != 27)
  2093.         odd++;
  2094.     }
  2095.  
  2096.     if ((odd * 30 > len) == (op->op_type == OP_FTTEXT)) /* allow 30% odd */
  2097.     RETPUSHNO;
  2098.     else
  2099.     RETPUSHYES;
  2100. }
  2101.  
  2102. PP(pp_ftbinary)
  2103. {
  2104.     return pp_fttext(ARGS);
  2105. }
  2106.  
  2107. /* File calls. */
  2108.  
  2109. PP(pp_chdir)
  2110. {
  2111.     dSP; dTARGET;
  2112.     char *tmps;
  2113.     SV **svp;
  2114.  
  2115.     if (MAXARG < 1)
  2116.     tmps = Nullch;
  2117.     else
  2118.     tmps = POPp;
  2119.     if (!tmps || !*tmps) {
  2120.     svp = hv_fetch(GvHVn(envgv), "HOME", 4, FALSE);
  2121.     if (svp)
  2122.         tmps = SvPV(*svp, na);
  2123.     }
  2124.     if (!tmps || !*tmps) {
  2125.     svp = hv_fetch(GvHVn(envgv), "LOGDIR", 6, FALSE);
  2126.     if (svp)
  2127.         tmps = SvPV(*svp, na);
  2128.     }
  2129.     TAINT_PROPER("chdir");
  2130.     PUSHi( chdir(tmps) >= 0 );
  2131.     RETURN;
  2132. }
  2133.  
  2134. PP(pp_chown)
  2135. {
  2136.     dSP; dMARK; dTARGET;
  2137.     I32 value;
  2138. #ifdef HAS_CHOWN
  2139.     value = (I32)apply(op->op_type, MARK, SP);
  2140.     SP = MARK;
  2141.     PUSHi(value);
  2142.     RETURN;
  2143. #else
  2144.     DIE(no_func, "Unsupported function chown");
  2145. #endif
  2146. }
  2147.  
  2148. PP(pp_chroot)
  2149. {
  2150.     dSP; dTARGET;
  2151.     char *tmps;
  2152. #ifdef HAS_CHROOT
  2153.     tmps = POPp;
  2154.     TAINT_PROPER("chroot");
  2155.     PUSHi( chroot(tmps) >= 0 );
  2156.     RETURN;
  2157. #else
  2158.     DIE(no_func, "chroot");
  2159. #endif
  2160. }
  2161.  
  2162. PP(pp_unlink)
  2163. {
  2164.     dSP; dMARK; dTARGET;
  2165.     I32 value;
  2166.     value = (I32)apply(op->op_type, MARK, SP);
  2167.     SP = MARK;
  2168.     PUSHi(value);
  2169.     RETURN;
  2170. }
  2171.  
  2172. PP(pp_chmod)
  2173. {
  2174.     dSP; dMARK; dTARGET;
  2175.     I32 value;
  2176.     value = (I32)apply(op->op_type, MARK, SP);
  2177.     SP = MARK;
  2178.     PUSHi(value);
  2179.     RETURN;
  2180. }
  2181.  
  2182. PP(pp_utime)
  2183. {
  2184.     dSP; dMARK; dTARGET;
  2185.     I32 value;
  2186.     value = (I32)apply(op->op_type, MARK, SP);
  2187.     SP = MARK;
  2188.     PUSHi(value);
  2189.     RETURN;
  2190. }
  2191.  
  2192. PP(pp_rename)
  2193. {
  2194.     dSP; dTARGET;
  2195.     int anum;
  2196.  
  2197.     char *tmps2 = POPp;
  2198.     char *tmps = SvPV(TOPs, na);
  2199.     TAINT_PROPER("rename");
  2200. #ifdef HAS_RENAME
  2201.     anum = rename(tmps, tmps2);
  2202. #else
  2203.     if (same_dirent(tmps2, tmps))    /* can always rename to same name */
  2204.     anum = 1;
  2205.     else {
  2206.     if (euid || Stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
  2207.         (void)UNLINK(tmps2);
  2208.     if (!(anum = link(tmps, tmps2)))
  2209.         anum = UNLINK(tmps);
  2210.     }
  2211. #endif
  2212.     SETi( anum >= 0 );
  2213.     RETURN;
  2214. }
  2215.  
  2216. PP(pp_link)
  2217. {
  2218.     dSP; dTARGET;
  2219. #ifdef HAS_LINK
  2220.     char *tmps2 = POPp;
  2221.     char *tmps = SvPV(TOPs, na);
  2222.     TAINT_PROPER("link");
  2223.     SETi( link(tmps, tmps2) >= 0 );
  2224. #else
  2225.     DIE(no_func, "Unsupported function link");
  2226. #endif
  2227.     RETURN;
  2228. }
  2229.  
  2230. PP(pp_symlink)
  2231. {
  2232.     dSP; dTARGET;
  2233. #ifdef HAS_SYMLINK
  2234.     char *tmps2 = POPp;
  2235.     char *tmps = SvPV(TOPs, na);
  2236.     TAINT_PROPER("symlink");
  2237.     SETi( symlink(tmps, tmps2) >= 0 );
  2238.     RETURN;
  2239. #else
  2240.     DIE(no_func, "symlink");
  2241. #endif
  2242. }
  2243.  
  2244. PP(pp_readlink)
  2245. {
  2246.     dSP; dTARGET;
  2247. #ifdef HAS_SYMLINK
  2248.     char *tmps;
  2249.     int len;
  2250.     tmps = POPp;
  2251.     len = readlink(tmps, buf, sizeof buf);
  2252.     EXTEND(SP, 1);
  2253.     if (len < 0)
  2254.     RETPUSHUNDEF;
  2255.     PUSHp(buf, len);
  2256.     RETURN;
  2257. #else
  2258.     EXTEND(SP, 1);
  2259.     RETSETUNDEF;        /* just pretend it's a normal file */
  2260. #endif
  2261. }
  2262.  
  2263. #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
  2264. static int
  2265. dooneliner(cmd, filename)
  2266. char *cmd;
  2267. char *filename;
  2268. {
  2269.     char mybuf[8192];
  2270.     char *s, *tmps;
  2271.     int anum = 1;
  2272.     FILE *myfp;
  2273.  
  2274.     strcpy(mybuf, cmd);
  2275.     strcat(mybuf, " ");
  2276.     for (s = mybuf+strlen(mybuf); *filename; ) {
  2277.     *s++ = '\\';
  2278.     *s++ = *filename++;
  2279.     }
  2280.     strcpy(s, " 2>&1");
  2281.     myfp = my_popen(mybuf, "r");
  2282.     if (myfp) {
  2283.     *mybuf = '\0';
  2284.     s = fgets(mybuf, sizeof mybuf, myfp);
  2285.     (void)my_pclose(myfp);
  2286.     if (s != Nullch) {
  2287.         for (errno = 1; errno < sys_nerr; errno++) {
  2288. #ifdef HAS_SYS_ERRLIST
  2289.         if (instr(mybuf, sys_errlist[errno]))    /* you don't see this */
  2290.             return 0;
  2291. #else
  2292.         char *errmsg;                /* especially if it isn't there */
  2293.  
  2294.         if (instr(mybuf,
  2295.                   (errmsg = strerror(errno)) ? errmsg : "NoErRoR"))
  2296.             return 0;
  2297. #endif
  2298.         }
  2299.         errno = 0;
  2300. #ifndef EACCES
  2301. #define EACCES EPERM
  2302. #endif
  2303.         if (instr(mybuf, "cannot make"))
  2304.         errno = EEXIST;
  2305.         else if (instr(mybuf, "existing file"))
  2306.         errno = EEXIST;
  2307.         else if (instr(mybuf, "ile exists"))
  2308.         errno = EEXIST;
  2309.         else if (instr(mybuf, "non-exist"))
  2310.         errno = ENOENT;
  2311.         else if (instr(mybuf, "does not exist"))
  2312.         errno = ENOENT;
  2313.         else if (instr(mybuf, "not empty"))
  2314.         errno = EBUSY;
  2315.         else if (instr(mybuf, "cannot access"))
  2316.         errno = EACCES;
  2317.         else
  2318.         errno = EPERM;
  2319.         return 0;
  2320.     }
  2321.     else {    /* some mkdirs return no failure indication */
  2322.         anum = (Stat(filename, &statbuf) >= 0);
  2323.         if (op->op_type == OP_RMDIR)
  2324.         anum = !anum;
  2325.         if (anum)
  2326.         errno = 0;
  2327.         else
  2328.         errno = EACCES;    /* a guess */
  2329.     }
  2330.     return anum;
  2331.     }
  2332.     else
  2333.     return 0;
  2334. }
  2335. #endif
  2336.  
  2337. PP(pp_mkdir)
  2338. {
  2339.     dSP; dTARGET;
  2340.     int mode = POPi;
  2341. #ifndef HAS_MKDIR
  2342.     int oldumask;
  2343. #endif
  2344.     char *tmps = SvPV(TOPs, na);
  2345.  
  2346.     TAINT_PROPER("mkdir");
  2347. #ifdef HAS_MKDIR
  2348.     SETi( mkdir(tmps, mode) >= 0 );
  2349. #else
  2350.     SETi( dooneliner("mkdir", tmps) );
  2351.     oldumask = umask(0);
  2352.     umask(oldumask);
  2353.     chmod(tmps, (mode & ~oldumask) & 0777);
  2354. #endif
  2355.     RETURN;
  2356. }
  2357.  
  2358. PP(pp_rmdir)
  2359. {
  2360.     dSP; dTARGET;
  2361.     char *tmps;
  2362.  
  2363.     tmps = POPp;
  2364.     TAINT_PROPER("rmdir");
  2365. #ifdef HAS_RMDIR
  2366.     XPUSHi( rmdir(tmps) >= 0 );
  2367. #else
  2368.     XPUSHi( dooneliner("rmdir", tmps) );
  2369. #endif
  2370.     RETURN;
  2371. }
  2372.  
  2373. /* Directory calls. */
  2374.  
  2375. PP(pp_open_dir)
  2376. {
  2377.     dSP;
  2378. #if defined(Direntry_t) && defined(HAS_READDIR)
  2379.     char *dirname = POPp;
  2380.     GV *gv = (GV*)POPs;
  2381.     register IO *io = GvIOn(gv);
  2382.  
  2383.     if (!io)
  2384.     goto nope;
  2385.  
  2386.     if (IoDIRP(io))
  2387.     closedir(IoDIRP(io));
  2388.     if (!(IoDIRP(io) = opendir(dirname)))
  2389.     goto nope;
  2390.  
  2391.     RETPUSHYES;
  2392. nope:
  2393.     if (!errno)
  2394.     errno = EBADF;
  2395.     RETPUSHUNDEF;
  2396. #else
  2397.     DIE(no_dir_func, "opendir");
  2398. #endif
  2399. }
  2400.  
  2401. PP(pp_readdir)
  2402. {
  2403.     dSP;
  2404. #if defined(Direntry_t) && defined(HAS_READDIR)
  2405. #ifndef I_DIRENT
  2406.     Direntry_t *readdir _((DIR *));
  2407. #endif
  2408.     register Direntry_t *dp;
  2409.     GV *gv = (GV*)POPs;
  2410.     register IO *io = GvIOn(gv);
  2411.  
  2412.     if (!io || !IoDIRP(io))
  2413.     goto nope;
  2414.  
  2415.     if (GIMME == G_ARRAY) {
  2416.     /*SUPPRESS 560*/
  2417.     while (dp = (Direntry_t *)readdir(IoDIRP(io))) {
  2418. #ifdef DIRNAMLEN
  2419.         XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
  2420. #else
  2421.         XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
  2422. #endif
  2423.     }
  2424.     }
  2425.     else {
  2426.     if (!(dp = (Direntry_t *)readdir(IoDIRP(io))))
  2427.         goto nope;
  2428. #ifdef DIRNAMLEN
  2429.     XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
  2430. #else
  2431.     XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
  2432. #endif
  2433.     }
  2434.     RETURN;
  2435.  
  2436. nope:
  2437.     if (!errno)
  2438.     errno = EBADF;
  2439.     if (GIMME == G_ARRAY)
  2440.     RETURN;
  2441.     else
  2442.     RETPUSHUNDEF;
  2443. #else
  2444.     DIE(no_dir_func, "readdir");
  2445. #endif
  2446. }
  2447.  
  2448. PP(pp_telldir)
  2449. {
  2450.     dSP; dTARGET;
  2451. #if defined(HAS_TELLDIR) || defined(telldir)
  2452. #if !defined(telldir) && !defined(HAS_TELLDIR_PROTOTYPE)
  2453.     long telldir _((DIR *));
  2454. #endif
  2455.     GV *gv = (GV*)POPs;
  2456.     register IO *io = GvIOn(gv);
  2457.  
  2458.     if (!io || !IoDIRP(io))
  2459.     goto nope;
  2460.  
  2461.     PUSHi( telldir(IoDIRP(io)) );
  2462.     RETURN;
  2463. nope:
  2464.     if (!errno)
  2465.     errno = EBADF;
  2466.     RETPUSHUNDEF;
  2467. #else
  2468.     DIE(no_dir_func, "telldir");
  2469. #endif
  2470. }
  2471.  
  2472. PP(pp_seekdir)
  2473. {
  2474.     dSP;
  2475. #if defined(HAS_SEEKDIR) || defined(seekdir)
  2476.     long along = POPl;
  2477.     GV *gv = (GV*)POPs;
  2478.     register IO *io = GvIOn(gv);
  2479.  
  2480.     if (!io || !IoDIRP(io))
  2481.     goto nope;
  2482.  
  2483.     (void)seekdir(IoDIRP(io), along);
  2484.  
  2485.     RETPUSHYES;
  2486. nope:
  2487.     if (!errno)
  2488.     errno = EBADF;
  2489.     RETPUSHUNDEF;
  2490. #else
  2491.     DIE(no_dir_func, "seekdir");
  2492. #endif
  2493. }
  2494.  
  2495. PP(pp_rewinddir)
  2496. {
  2497.     dSP;
  2498. #if defined(HAS_REWINDDIR) || defined(rewinddir)
  2499.     GV *gv = (GV*)POPs;
  2500.     register IO *io = GvIOn(gv);
  2501.  
  2502.     if (!io || !IoDIRP(io))
  2503.     goto nope;
  2504.  
  2505.     (void)rewinddir(IoDIRP(io));
  2506.     RETPUSHYES;
  2507. nope:
  2508.     if (!errno)
  2509.     errno = EBADF;
  2510.     RETPUSHUNDEF;
  2511. #else
  2512.     DIE(no_dir_func, "rewinddir");
  2513. #endif
  2514. }
  2515.  
  2516. PP(pp_closedir)
  2517. {
  2518.     dSP;
  2519. #if defined(Direntry_t) && defined(HAS_READDIR)
  2520.     GV *gv = (GV*)POPs;
  2521.     register IO *io = GvIOn(gv);
  2522.  
  2523.     if (!io || !IoDIRP(io))
  2524.     goto nope;
  2525.  
  2526. #ifdef VOID_CLOSEDIR
  2527.     closedir(IoDIRP(io));
  2528. #else
  2529.     if (closedir(IoDIRP(io)) < 0)
  2530.     goto nope;
  2531. #endif
  2532.     IoDIRP(io) = 0;
  2533.  
  2534.     RETPUSHYES;
  2535. nope:
  2536.     if (!errno)
  2537.     errno = EBADF;
  2538.     RETPUSHUNDEF;
  2539. #else
  2540.     DIE(no_dir_func, "closedir");
  2541. #endif
  2542. }
  2543.  
  2544. /* Process control. */
  2545.  
  2546. PP(pp_fork)
  2547. {
  2548.     dSP; dTARGET;
  2549.     int childpid;
  2550.     GV *tmpgv;
  2551.  
  2552.     EXTEND(SP, 1);
  2553. #ifdef HAS_FORK
  2554.     childpid = fork();
  2555.     if (childpid < 0)
  2556.     RETSETUNDEF;
  2557.     if (!childpid) {
  2558.     /*SUPPRESS 560*/
  2559.     if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
  2560.         sv_setiv(GvSV(tmpgv), (I32)getpid());
  2561.     hv_clear(pidstatus);    /* no kids, so don't wait for 'em */
  2562.     }
  2563.     PUSHi(childpid);
  2564.     RETURN;
  2565. #else
  2566.     DIE(no_func, "Unsupported function fork");
  2567. #endif
  2568. }
  2569.  
  2570. PP(pp_wait)
  2571. {
  2572.     dSP; dTARGET;
  2573.     int childpid;
  2574.     int argflags;
  2575.     I32 value;
  2576.  
  2577.     EXTEND(SP, 1);
  2578. #ifdef HAS_WAIT
  2579.     childpid = wait(&argflags);
  2580.     if (childpid > 0)
  2581.     pidgone(childpid, argflags);
  2582.     value = (I32)childpid;
  2583.     statusvalue = (U16)argflags;
  2584.     PUSHi(value);
  2585.     RETURN;
  2586. #else
  2587.     DIE(no_func, "Unsupported function wait");
  2588. #endif
  2589. }
  2590.  
  2591. PP(pp_waitpid)
  2592. {
  2593.     dSP; dTARGET;
  2594.     int childpid;
  2595.     int optype;
  2596.     int argflags;
  2597.     I32 value;
  2598.  
  2599. #ifdef HAS_WAIT
  2600.     optype = POPi;
  2601.     childpid = TOPi;
  2602.     childpid = wait4pid(childpid, &argflags, optype);
  2603.     value = (I32)childpid;
  2604.     statusvalue = (U16)argflags;
  2605.     SETi(value);
  2606.     RETURN;
  2607. #else
  2608.     DIE(no_func, "Unsupported function wait");
  2609. #endif
  2610. }
  2611.  
  2612. PP(pp_system)
  2613. {
  2614.     dSP; dMARK; dORIGMARK; dTARGET;
  2615.     I32 value;
  2616.     int childpid;
  2617.     int result;
  2618.     int status;
  2619.     VOIDRET (*ihand)();     /* place to save signal during system() */
  2620.     VOIDRET (*qhand)();     /* place to save signal during system() */
  2621.  
  2622. #if defined(HAS_FORK) && !defined(VMS)
  2623.     if (SP - MARK == 1) {
  2624.     if (tainting) {
  2625.         char *junk = SvPV(TOPs, na);
  2626.         TAINT_ENV();
  2627.         TAINT_PROPER("system");
  2628.     }
  2629.     }
  2630.     while ((childpid = vfork()) == -1) {
  2631.     if (errno != EAGAIN) {
  2632.         value = -1;
  2633.         SP = ORIGMARK;
  2634.         PUSHi(value);
  2635.         RETURN;
  2636.     }
  2637.     sleep(5);
  2638.     }
  2639.     if (childpid > 0) {
  2640.     ihand = signal(SIGINT, SIG_IGN);
  2641.     qhand = signal(SIGQUIT, SIG_IGN);
  2642.     result = wait4pid(childpid, &status, 0);
  2643.     (void)signal(SIGINT, ihand);
  2644.     (void)signal(SIGQUIT, qhand);
  2645.     statusvalue = (U16)status;
  2646.     if (result < 0)
  2647.         value = -1;
  2648.     else {
  2649.         value = (I32)((unsigned int)status & 0xffff);
  2650.     }
  2651.     do_execfree();    /* free any memory child malloced on vfork */
  2652.     SP = ORIGMARK;
  2653.     PUSHi(value);
  2654.     RETURN;
  2655.     }
  2656.     if (op->op_flags & OPf_STACKED) {
  2657.     SV *really = *++MARK;
  2658.     value = (I32)do_aexec(really, MARK, SP);
  2659.     }
  2660.     else if (SP - MARK != 1)
  2661.     value = (I32)do_aexec(Nullsv, MARK, SP);
  2662.     else {
  2663.     value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
  2664.     }
  2665.     _exit(-1);
  2666. #else /* ! FORK or VMS */
  2667.     if (op->op_flags & OPf_STACKED) {
  2668.     SV *really = *++MARK;
  2669.     value = (I32)do_aspawn(really, MARK, SP);
  2670.     }
  2671.     else if (SP - MARK != 1)
  2672.     value = (I32)do_aspawn(Nullsv, MARK, SP);
  2673.     else {
  2674.     value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
  2675.     }
  2676.     do_execfree();
  2677.     SP = ORIGMARK;
  2678.     PUSHi(value);
  2679. #endif /* !FORK or VMS */
  2680.     RETURN;
  2681. }
  2682.  
  2683. PP(pp_exec)
  2684. {
  2685.     dSP; dMARK; dORIGMARK; dTARGET;
  2686.     I32 value;
  2687.  
  2688.     if (op->op_flags & OPf_STACKED) {
  2689.     SV *really = *++MARK;
  2690.     value = (I32)do_aexec(really, MARK, SP);
  2691.     }
  2692.     else if (SP - MARK != 1)
  2693. #ifdef VMS
  2694.     value = (I32)vms_do_aexec(Nullsv, MARK, SP);
  2695. #else
  2696.     value = (I32)do_aexec(Nullsv, MARK, SP);
  2697. #endif
  2698.     else {
  2699.     if (tainting) {
  2700.         char *junk = SvPV(*SP, na);
  2701.         TAINT_ENV();
  2702.         TAINT_PROPER("exec");
  2703.     }
  2704. #ifdef VMS
  2705.     value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), na));
  2706. #else
  2707.     value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
  2708. #endif
  2709.     }
  2710.     SP = ORIGMARK;
  2711.     PUSHi(value);
  2712.     RETURN;
  2713. }
  2714.  
  2715. PP(pp_kill)
  2716. {
  2717.     dSP; dMARK; dTARGET;
  2718.     I32 value;
  2719. #ifdef HAS_KILL
  2720.     value = (I32)apply(op->op_type, MARK, SP);
  2721.     SP = MARK;
  2722.     PUSHi(value);
  2723.     RETURN;
  2724. #else
  2725.     DIE(no_func, "Unsupported function kill");
  2726. #endif
  2727. }
  2728.  
  2729. PP(pp_getppid)
  2730. {
  2731. #ifdef HAS_GETPPID
  2732.     dSP; dTARGET;
  2733.     XPUSHi( getppid() );
  2734.     RETURN;
  2735. #else
  2736.     DIE(no_func, "getppid");
  2737. #endif
  2738. }
  2739.  
  2740. PP(pp_getpgrp)
  2741. {
  2742. #ifdef HAS_GETPGRP
  2743.     dSP; dTARGET;
  2744.     int pid;
  2745.     I32 value;
  2746.  
  2747.     if (MAXARG < 1)
  2748.     pid = 0;
  2749.     else
  2750.     pid = SvIVx(POPs);
  2751. #ifdef USE_BSDPGRP
  2752.     value = (I32)getpgrp(pid);
  2753. #else
  2754.     if (pid != 0)
  2755.     DIE("POSIX getpgrp can't take an argument");
  2756.     value = (I32)getpgrp();
  2757. #endif
  2758.     XPUSHi(value);
  2759.     RETURN;
  2760. #else
  2761.     DIE(no_func, "getpgrp()");
  2762. #endif
  2763. }
  2764.  
  2765. PP(pp_setpgrp)
  2766. {
  2767. #ifdef HAS_SETPGRP
  2768.     dSP; dTARGET;
  2769.     int pgrp;
  2770.     int pid;
  2771.     if (MAXARG < 2) {
  2772.     pgrp = 0;
  2773.     pid = 0;
  2774.     }
  2775.     else {
  2776.     pgrp = POPi;
  2777.     pid = TOPi;
  2778.     }
  2779.  
  2780.     TAINT_PROPER("setpgrp");
  2781. #ifdef USE_BSDPGRP
  2782.     SETi( setpgrp(pid, pgrp) >= 0 );
  2783. #else
  2784.     if ((pgrp != 0) || (pid != 0)) {
  2785.     DIE("POSIX setpgrp can't take an argument");
  2786.     }
  2787.     SETi( setpgrp() >= 0 );
  2788. #endif /* USE_BSDPGRP */
  2789.     RETURN;
  2790. #else
  2791.     DIE(no_func, "setpgrp()");
  2792. #endif
  2793. }
  2794.  
  2795. PP(pp_getpriority)
  2796. {
  2797.     dSP; dTARGET;
  2798.     int which;
  2799.     int who;
  2800. #ifdef HAS_GETPRIORITY
  2801.     who = POPi;
  2802.     which = TOPi;
  2803.     SETi( getpriority(which, who) );
  2804.     RETURN;
  2805. #else
  2806.     DIE(no_func, "getpriority()");
  2807. #endif
  2808. }
  2809.  
  2810. PP(pp_setpriority)
  2811. {
  2812.     dSP; dTARGET;
  2813.     int which;
  2814.     int who;
  2815.     int niceval;
  2816. #ifdef HAS_SETPRIORITY
  2817.     niceval = POPi;
  2818.     who = POPi;
  2819.     which = TOPi;
  2820.     TAINT_PROPER("setpriority");
  2821.     SETi( setpriority(which, who, niceval) >= 0 );
  2822.     RETURN;
  2823. #else
  2824.     DIE(no_func, "setpriority()");
  2825. #endif
  2826. }
  2827.  
  2828. /* Time calls. */
  2829.  
  2830. PP(pp_time)
  2831. {
  2832.     dSP; dTARGET;
  2833.     XPUSHi( time(Null(Time_t*)) );
  2834.     RETURN;
  2835. }
  2836.  
  2837. #ifndef HZ
  2838. #define HZ 60
  2839. #endif
  2840.  
  2841. PP(pp_tms)
  2842. {
  2843.     dSP;
  2844.  
  2845. #if defined(MSDOS) || !defined(HAS_TIMES)
  2846.     DIE("times not implemented");
  2847. #else
  2848.     EXTEND(SP, 4);
  2849.  
  2850. #ifndef VMS
  2851.     (void)times(×buf);
  2852. #else
  2853.     (void)times((tbuffer_t *)×buf);  /* time.h uses different name for */
  2854.                                           /* struct tms, though same data   */
  2855.                                           /* is returned.                   */
  2856. #endif
  2857.  
  2858.     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_utime)/HZ)));
  2859.     if (GIMME == G_ARRAY) {
  2860.     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_stime)/HZ)));
  2861.     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cutime)/HZ)));
  2862.     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cstime)/HZ)));
  2863.     }
  2864.     RETURN;
  2865. #endif /* MSDOS */
  2866. }
  2867.  
  2868. PP(pp_localtime)
  2869. {
  2870.     return pp_gmtime(ARGS);
  2871. }
  2872.  
  2873. PP(pp_gmtime)
  2874. {
  2875.     dSP;
  2876.     Time_t when;
  2877.     struct tm *tmbuf;
  2878.     static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
  2879.     static char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
  2880.                   "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
  2881.  
  2882.     if (MAXARG < 1)
  2883.     (void)time(&when);
  2884.     else
  2885.     when = (Time_t)SvIVx(POPs);
  2886.  
  2887.     if (op->op_type == OP_LOCALTIME)
  2888.     tmbuf = localtime(&when);
  2889.     else
  2890.     tmbuf = gmtime(&when);
  2891.  
  2892.     EXTEND(SP, 9);
  2893.     if (GIMME != G_ARRAY) {
  2894.     dTARGET;
  2895.     char mybuf[30];
  2896.     if (!tmbuf)
  2897.         RETPUSHUNDEF;
  2898.     sprintf(mybuf, "%s %s %2d %02d:%02d:%02d %d",
  2899.         dayname[tmbuf->tm_wday],
  2900.         monname[tmbuf->tm_mon],
  2901.         tmbuf->tm_mday,
  2902.         tmbuf->tm_hour,
  2903.         tmbuf->tm_min,
  2904.         tmbuf->tm_sec,
  2905.         tmbuf->tm_year + 1900);
  2906.     PUSHp(mybuf, strlen(mybuf));
  2907.     }
  2908.     else if (tmbuf) {
  2909.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec)));
  2910.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_min)));
  2911.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_hour)));
  2912.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mday)));
  2913.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mon)));
  2914.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_year)));
  2915.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_wday)));
  2916.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_yday)));
  2917.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_isdst)));
  2918.     }
  2919.     RETURN;
  2920. }
  2921.  
  2922. PP(pp_alarm)
  2923. {
  2924.     dSP; dTARGET;
  2925.     int anum;
  2926. #ifdef HAS_ALARM
  2927.     anum = POPi;
  2928.     anum = alarm((unsigned int)anum);
  2929.     EXTEND(SP, 1);
  2930.     if (anum < 0)
  2931.     RETPUSHUNDEF;
  2932.     PUSHi((I32)anum);
  2933.     RETURN;
  2934. #else
  2935.     DIE(no_func, "Unsupported function alarm");
  2936.     break;
  2937. #endif
  2938. }
  2939.  
  2940. PP(pp_sleep)
  2941. {
  2942.     dSP; dTARGET;
  2943.     I32 duration;
  2944.     Time_t lasttime;
  2945.     Time_t when;
  2946.  
  2947.     (void)time(&lasttime);
  2948.     if (MAXARG < 1)
  2949.     pause();
  2950.     else {
  2951.     duration = POPi;
  2952.     sleep((unsigned int)duration);
  2953.     }
  2954.     (void)time(&when);
  2955.     XPUSHi(when - lasttime);
  2956.     RETURN;
  2957. }
  2958.  
  2959. /* Shared memory. */
  2960.  
  2961. PP(pp_shmget)
  2962. {
  2963.     return pp_semget(ARGS);
  2964. }
  2965.  
  2966. PP(pp_shmctl)
  2967. {
  2968.     return pp_semctl(ARGS);
  2969. }
  2970.  
  2971. PP(pp_shmread)
  2972. {
  2973.     return pp_shmwrite(ARGS);
  2974. }
  2975.  
  2976. PP(pp_shmwrite)
  2977. {
  2978. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  2979.     dSP; dMARK; dTARGET;
  2980.     I32 value = (I32)(do_shmio(op->op_type, MARK, SP) >= 0);
  2981.     SP = MARK;
  2982.     PUSHi(value);
  2983.     RETURN;
  2984. #else
  2985.     pp_semget(ARGS);
  2986. #endif
  2987. }
  2988.  
  2989. /* Message passing. */
  2990.  
  2991. PP(pp_msgget)
  2992. {
  2993.     return pp_semget(ARGS);
  2994. }
  2995.  
  2996. PP(pp_msgctl)
  2997. {
  2998.     return pp_semctl(ARGS);
  2999. }
  3000.  
  3001. PP(pp_msgsnd)
  3002. {
  3003. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3004.     dSP; dMARK; dTARGET;
  3005.     I32 value = (I32)(do_msgsnd(MARK, SP) >= 0);
  3006.     SP = MARK;
  3007.     PUSHi(value);
  3008.     RETURN;
  3009. #else
  3010.     pp_semget(ARGS);
  3011. #endif
  3012. }
  3013.  
  3014. PP(pp_msgrcv)
  3015. {
  3016. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3017.     dSP; dMARK; dTARGET;
  3018.     I32 value = (I32)(do_msgrcv(MARK, SP) >= 0);
  3019.     SP = MARK;
  3020.     PUSHi(value);
  3021.     RETURN;
  3022. #else
  3023.     pp_semget(ARGS);
  3024. #endif
  3025. }
  3026.  
  3027. /* Semaphores. */
  3028.  
  3029. PP(pp_semget)
  3030. {
  3031. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3032.     dSP; dMARK; dTARGET;
  3033.     int anum = do_ipcget(op->op_type, MARK, SP);
  3034.     SP = MARK;
  3035.     if (anum == -1)
  3036.     RETPUSHUNDEF;
  3037.     PUSHi(anum);
  3038.     RETURN;
  3039. #else
  3040.     DIE("System V IPC is not implemented on this machine");
  3041. #endif
  3042. }
  3043.  
  3044. PP(pp_semctl)
  3045. {
  3046. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3047.     dSP; dMARK; dTARGET;
  3048.     int anum = do_ipcctl(op->op_type, MARK, SP);
  3049.     SP = MARK;
  3050.     if (anum == -1)
  3051.     RETSETUNDEF;
  3052.     if (anum != 0) {
  3053.     PUSHi(anum);
  3054.     }
  3055.     else {
  3056.     PUSHp("0 but true",10);
  3057.     }
  3058.     RETURN;
  3059. #else
  3060.     pp_semget(ARGS);
  3061. #endif
  3062. }
  3063.  
  3064. PP(pp_semop)
  3065. {
  3066. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3067.     dSP; dMARK; dTARGET;
  3068.     I32 value = (I32)(do_semop(MARK, SP) >= 0);
  3069.     SP = MARK;
  3070.     PUSHi(value);
  3071.     RETURN;
  3072. #else
  3073.     pp_semget(ARGS);
  3074. #endif
  3075. }
  3076.  
  3077. /* Get system info. */
  3078.  
  3079. PP(pp_ghbyname)
  3080. {
  3081. #ifdef HAS_SOCKET
  3082.     return pp_ghostent(ARGS);
  3083. #else
  3084.     DIE(no_sock_func, "gethostbyname");
  3085. #endif
  3086. }
  3087.  
  3088. PP(pp_ghbyaddr)
  3089. {
  3090. #ifdef HAS_SOCKET
  3091.     return pp_ghostent(ARGS);
  3092. #else
  3093.     DIE(no_sock_func, "gethostbyaddr");
  3094. #endif
  3095. }
  3096.  
  3097. PP(pp_ghostent)
  3098. {
  3099.     dSP;
  3100. #ifdef HAS_SOCKET
  3101.     I32 which = op->op_type;
  3102.     register char **elem;
  3103.     register SV *sv;
  3104.     struct hostent *gethostbyname();
  3105.     struct hostent *gethostbyaddr();
  3106. #ifdef HAS_GETHOSTENT
  3107.     struct hostent *gethostent();
  3108. #endif
  3109.     struct hostent *hent;
  3110.     unsigned long len;
  3111.  
  3112.     EXTEND(SP, 10);
  3113.     if (which == OP_GHBYNAME) {
  3114.     hent = gethostbyname(POPp);
  3115.     }
  3116.     else if (which == OP_GHBYADDR) {
  3117.     int addrtype = POPi;
  3118.     SV *addrstr = POPs;
  3119.     STRLEN addrlen;
  3120.     char *addr = SvPV(addrstr, addrlen);
  3121.  
  3122.     hent = gethostbyaddr(addr, addrlen, addrtype);
  3123.     }
  3124.     else
  3125. #ifdef HAS_GETHOSTENT
  3126.     hent = gethostent();
  3127. #else
  3128.     DIE("gethostent not implemented");
  3129. #endif
  3130.  
  3131. #ifdef HOST_NOT_FOUND
  3132.     if (!hent)
  3133.     statusvalue = (U16)h_errno & 0xffff;
  3134. #endif
  3135.  
  3136.     if (GIMME != G_ARRAY) {
  3137.     PUSHs(sv = sv_newmortal());
  3138.     if (hent) {
  3139.         if (which == OP_GHBYNAME) {
  3140.         sv_setpvn(sv, hent->h_addr, hent->h_length);
  3141.         }
  3142.         else
  3143.         sv_setpv(sv, (char*)hent->h_name);
  3144.     }
  3145.     RETURN;
  3146.     }
  3147.  
  3148.     if (hent) {
  3149.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3150.     sv_setpv(sv, (char*)hent->h_name);
  3151.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3152.     for (elem = hent->h_aliases; elem && *elem; elem++) {
  3153.         sv_catpv(sv, *elem);
  3154.         if (elem[1])
  3155.         sv_catpvn(sv, " ", 1);
  3156.     }
  3157.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3158.     sv_setiv(sv, (I32)hent->h_addrtype);
  3159.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3160.     len = hent->h_length;
  3161.     sv_setiv(sv, (I32)len);
  3162. #ifdef h_addr
  3163.     for (elem = hent->h_addr_list; elem && *elem; elem++) {
  3164.         XPUSHs(sv = sv_mortalcopy(&sv_no));
  3165.         sv_setpvn(sv, *elem, len);
  3166.     }
  3167. #else
  3168.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3169.     sv_setpvn(sv, hent->h_addr, len);
  3170. #endif /* h_addr */
  3171.     }
  3172.     RETURN;
  3173. #else
  3174.     DIE(no_sock_func, "gethostent");
  3175. #endif
  3176. }
  3177.  
  3178. PP(pp_gnbyname)
  3179. {
  3180. #ifdef HAS_SOCKET
  3181.     return pp_gnetent(ARGS);
  3182. #else
  3183.     DIE(no_sock_func, "getnetbyname");
  3184. #endif
  3185. }
  3186.  
  3187. PP(pp_gnbyaddr)
  3188. {
  3189. #ifdef HAS_SOCKET
  3190.     return pp_gnetent(ARGS);
  3191. #else
  3192.     DIE(no_sock_func, "getnetbyaddr");
  3193. #endif
  3194. }
  3195.  
  3196. PP(pp_gnetent)
  3197. {
  3198.     dSP;
  3199. #ifdef HAS_SOCKET
  3200.     I32 which = op->op_type;
  3201.     register char **elem;
  3202.     register SV *sv;
  3203.     struct netent *getnetbyname();
  3204.     struct netent *getnetbyaddr();
  3205.     struct netent *getnetent();
  3206.     struct netent *nent;
  3207.  
  3208.     if (which == OP_GNBYNAME)
  3209.     nent = getnetbyname(POPp);
  3210.     else if (which == OP_GNBYADDR) {
  3211.     int addrtype = POPi;
  3212.     unsigned long addr = U_L(POPn);
  3213.     nent = getnetbyaddr((long)addr, addrtype);
  3214.     }
  3215.     else
  3216.     nent = getnetent();
  3217.  
  3218.     EXTEND(SP, 4);
  3219.     if (GIMME != G_ARRAY) {
  3220.     PUSHs(sv = sv_newmortal());
  3221.     if (nent) {
  3222.         if (which == OP_GNBYNAME)
  3223.         sv_setiv(sv, (I32)nent->n_net);
  3224.         else
  3225.         sv_setpv(sv, nent->n_name);
  3226.     }
  3227.     RETURN;
  3228.     }
  3229.  
  3230.     if (nent) {
  3231.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3232.     sv_setpv(sv, nent->n_name);
  3233.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3234.     for (elem = nent->n_aliases; *elem; elem++) {
  3235.         sv_catpv(sv, *elem);
  3236.         if (elem[1])
  3237.         sv_catpvn(sv, " ", 1);
  3238.     }
  3239.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3240.     sv_setiv(sv, (I32)nent->n_addrtype);
  3241.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3242.     sv_setiv(sv, (I32)nent->n_net);
  3243.     }
  3244.  
  3245.     RETURN;
  3246. #else
  3247.     DIE(no_sock_func, "getnetent");
  3248. #endif
  3249. }
  3250.  
  3251. PP(pp_gpbyname)
  3252. {
  3253. #ifdef HAS_SOCKET
  3254.     return pp_gprotoent(ARGS);
  3255. #else
  3256.     DIE(no_sock_func, "getprotobyname");
  3257. #endif
  3258. }
  3259.  
  3260. PP(pp_gpbynumber)
  3261. {
  3262. #ifdef HAS_SOCKET
  3263.     return pp_gprotoent(ARGS);
  3264. #else
  3265.     DIE(no_sock_func, "getprotobynumber");
  3266. #endif
  3267. }
  3268.  
  3269. PP(pp_gprotoent)
  3270. {
  3271.     dSP;
  3272. #ifdef HAS_SOCKET
  3273.     I32 which = op->op_type;
  3274.     register char **elem;
  3275.     register SV *sv;
  3276.     struct protoent *getprotobyname();
  3277.     struct protoent *getprotobynumber();
  3278.     struct protoent *getprotoent();
  3279.     struct protoent *pent;
  3280.  
  3281.     if (which == OP_GPBYNAME)
  3282.     pent = getprotobyname(POPp);
  3283.     else if (which == OP_GPBYNUMBER)
  3284.     pent = getprotobynumber(POPi);
  3285.     else
  3286.     pent = getprotoent();
  3287.  
  3288.     EXTEND(SP, 3);
  3289.     if (GIMME != G_ARRAY) {
  3290.     PUSHs(sv = sv_newmortal());
  3291.     if (pent) {
  3292.         if (which == OP_GPBYNAME)
  3293.         sv_setiv(sv, (I32)pent->p_proto);
  3294.         else
  3295.         sv_setpv(sv, pent->p_name);
  3296.     }
  3297.     RETURN;
  3298.     }
  3299.  
  3300.     if (pent) {
  3301.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3302.     sv_setpv(sv, pent->p_name);
  3303.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3304.     for (elem = pent->p_aliases; *elem; elem++) {
  3305.         sv_catpv(sv, *elem);
  3306.         if (elem[1])
  3307.         sv_catpvn(sv, " ", 1);
  3308.     }
  3309.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3310.     sv_setiv(sv, (I32)pent->p_proto);
  3311.     }
  3312.  
  3313.     RETURN;
  3314. #else
  3315.     DIE(no_sock_func, "getprotoent");
  3316. #endif
  3317. }
  3318.  
  3319. PP(pp_gsbyname)
  3320. {
  3321. #ifdef HAS_SOCKET
  3322.     return pp_gservent(ARGS);
  3323. #else
  3324.     DIE(no_sock_func, "getservbyname");
  3325. #endif
  3326. }
  3327.  
  3328. PP(pp_gsbyport)
  3329. {
  3330. #ifdef HAS_SOCKET
  3331.     return pp_gservent(ARGS);
  3332. #else
  3333.     DIE(no_sock_func, "getservbyport");
  3334. #endif
  3335. }
  3336.  
  3337. PP(pp_gservent)
  3338. {
  3339.     dSP;
  3340. #ifdef HAS_SOCKET
  3341.     I32 which = op->op_type;
  3342.     register char **elem;
  3343.     register SV *sv;
  3344.     struct servent *getservbyname();
  3345.     struct servent *getservbynumber();
  3346.     struct servent *getservent();
  3347.     struct servent *sent;
  3348.  
  3349.     if (which == OP_GSBYNAME) {
  3350.     char *proto = POPp;
  3351.     char *name = POPp;
  3352.  
  3353.     if (proto && !*proto)
  3354.         proto = Nullch;
  3355.  
  3356.     sent = getservbyname(name, proto);
  3357.     }
  3358.     else if (which == OP_GSBYPORT) {
  3359.     char *proto = POPp;
  3360.     int port = POPi;
  3361.  
  3362.     sent = getservbyport(port, proto);
  3363.     }
  3364.     else
  3365.     sent = getservent();
  3366.  
  3367.     EXTEND(SP, 4);
  3368.     if (GIMME != G_ARRAY) {
  3369.     PUSHs(sv = sv_newmortal());
  3370.     if (sent) {
  3371.         if (which == OP_GSBYNAME) {
  3372. #ifdef HAS_NTOHS
  3373.         sv_setiv(sv, (I32)ntohs(sent->s_port));
  3374. #else
  3375.         sv_setiv(sv, (I32)(sent->s_port));
  3376. #endif
  3377.         }
  3378.         else
  3379.         sv_setpv(sv, sent->s_name);
  3380.     }
  3381.     RETURN;
  3382.     }
  3383.  
  3384.     if (sent) {
  3385.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3386.     sv_setpv(sv, sent->s_name);
  3387.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3388.     for (elem = sent->s_aliases; *elem; elem++) {
  3389.         sv_catpv(sv, *elem);
  3390.         if (elem[1])
  3391.         sv_catpvn(sv, " ", 1);
  3392.     }
  3393.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3394. #ifdef HAS_NTOHS
  3395.     sv_setiv(sv, (I32)ntohs(sent->s_port));
  3396. #else
  3397.     sv_setiv(sv, (I32)(sent->s_port));
  3398. #endif
  3399.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3400.     sv_setpv(sv, sent->s_proto);
  3401.     }
  3402.  
  3403.     RETURN;
  3404. #else
  3405.     DIE(no_sock_func, "getservent");
  3406. #endif
  3407. }
  3408.  
  3409. PP(pp_shostent)
  3410. {
  3411.     dSP;
  3412. #ifdef HAS_SOCKET
  3413.     sethostent(TOPi);
  3414.     RETSETYES;
  3415. #else
  3416.     DIE(no_sock_func, "sethostent");
  3417. #endif
  3418. }
  3419.  
  3420. PP(pp_snetent)
  3421. {
  3422.     dSP;
  3423. #ifdef HAS_SOCKET
  3424.     setnetent(TOPi);
  3425.     RETSETYES;
  3426. #else
  3427.     DIE(no_sock_func, "setnetent");
  3428. #endif
  3429. }
  3430.  
  3431. PP(pp_sprotoent)
  3432. {
  3433.     dSP;
  3434. #ifdef HAS_SOCKET
  3435.     setprotoent(TOPi);
  3436.     RETSETYES;
  3437. #else
  3438.     DIE(no_sock_func, "setprotoent");
  3439. #endif
  3440. }
  3441.  
  3442. PP(pp_sservent)
  3443. {
  3444.     dSP;
  3445. #ifdef HAS_SOCKET
  3446.     setservent(TOPi);
  3447.     RETSETYES;
  3448. #else
  3449.     DIE(no_sock_func, "setservent");
  3450. #endif
  3451. }
  3452.  
  3453. PP(pp_ehostent)
  3454. {
  3455.     dSP;
  3456. #ifdef HAS_SOCKET
  3457.     endhostent();
  3458.     EXTEND(sp,1);
  3459.     RETPUSHYES;
  3460. #else
  3461.     DIE(no_sock_func, "endhostent");
  3462. #endif
  3463. }
  3464.  
  3465. PP(pp_enetent)
  3466. {
  3467.     dSP;
  3468. #ifdef HAS_SOCKET
  3469.     endnetent();
  3470.     EXTEND(sp,1);
  3471.     RETPUSHYES;
  3472. #else
  3473.     DIE(no_sock_func, "endnetent");
  3474. #endif
  3475. }
  3476.  
  3477. PP(pp_eprotoent)
  3478. {
  3479.     dSP;
  3480. #ifdef HAS_SOCKET
  3481.     endprotoent();
  3482.     EXTEND(sp,1);
  3483.     RETPUSHYES;
  3484. #else
  3485.     DIE(no_sock_func, "endprotoent");
  3486. #endif
  3487. }
  3488.  
  3489. PP(pp_eservent)
  3490. {
  3491.     dSP;
  3492. #ifdef HAS_SOCKET
  3493.     endservent();
  3494.     EXTEND(sp,1);
  3495.     RETPUSHYES;
  3496. #else
  3497.     DIE(no_sock_func, "endservent");
  3498. #endif
  3499. }
  3500.  
  3501. PP(pp_gpwnam)
  3502. {
  3503. #ifdef HAS_PASSWD
  3504.     return pp_gpwent(ARGS);
  3505. #else
  3506.     DIE(no_func, "getpwnam");
  3507. #endif
  3508. }
  3509.  
  3510. PP(pp_gpwuid)
  3511. {
  3512. #ifdef HAS_PASSWD
  3513.     return pp_gpwent(ARGS);
  3514. #else
  3515.     DIE(no_func, "getpwuid");
  3516. #endif
  3517. }
  3518.  
  3519. PP(pp_gpwent)
  3520. {
  3521.     dSP;
  3522. #ifdef HAS_PASSWD
  3523.     I32 which = op->op_type;
  3524.     register SV *sv;
  3525.     struct passwd *pwent;
  3526.  
  3527.     if (which == OP_GPWNAM)
  3528.     pwent = getpwnam(POPp);
  3529.     else if (which == OP_GPWUID)
  3530.     pwent = getpwuid(POPi);
  3531.     else
  3532.     pwent = (struct passwd *)getpwent();
  3533.  
  3534.     EXTEND(SP, 10);
  3535.     if (GIMME != G_ARRAY) {
  3536.     PUSHs(sv = sv_newmortal());
  3537.     if (pwent) {
  3538.         if (which == OP_GPWNAM)
  3539.         sv_setiv(sv, (I32)pwent->pw_uid);
  3540.         else
  3541.         sv_setpv(sv, pwent->pw_name);
  3542.     }
  3543.     RETURN;
  3544.     }
  3545.  
  3546.     if (pwent) {
  3547.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3548.     sv_setpv(sv, pwent->pw_name);
  3549.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3550.     sv_setpv(sv, pwent->pw_passwd);
  3551.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3552.     sv_setiv(sv, (I32)pwent->pw_uid);
  3553.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3554.     sv_setiv(sv, (I32)pwent->pw_gid);
  3555.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3556. #ifdef PWCHANGE
  3557.     sv_setiv(sv, (I32)pwent->pw_change);
  3558. #else
  3559. #ifdef PWQUOTA
  3560.     sv_setiv(sv, (I32)pwent->pw_quota);
  3561. #else
  3562. #ifdef PWAGE
  3563.     sv_setpv(sv, pwent->pw_age);
  3564. #endif
  3565. #endif
  3566. #endif
  3567.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3568. #ifdef PWCLASS
  3569.     sv_setpv(sv, pwent->pw_class);
  3570. #else
  3571. #ifdef PWCOMMENT
  3572.     sv_setpv(sv, pwent->pw_comment);
  3573. #endif
  3574. #endif
  3575.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3576.     sv_setpv(sv, pwent->pw_gecos);
  3577.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3578.     sv_setpv(sv, pwent->pw_dir);
  3579.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3580.     sv_setpv(sv, pwent->pw_shell);
  3581. #ifdef PWEXPIRE
  3582.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3583.     sv_setiv(sv, (I32)pwent->pw_expire);
  3584. #endif
  3585.     }
  3586.     RETURN;
  3587. #else
  3588.     DIE(no_func, "getpwent");
  3589. #endif
  3590. }
  3591.  
  3592. PP(pp_spwent)
  3593. {
  3594.     dSP;
  3595. #ifdef HAS_PASSWD
  3596.     setpwent();
  3597.     RETPUSHYES;
  3598. #else
  3599.     DIE(no_func, "setpwent");
  3600. #endif
  3601. }
  3602.  
  3603. PP(pp_epwent)
  3604. {
  3605.     dSP;
  3606. #ifdef HAS_PASSWD
  3607.     endpwent();
  3608.     RETPUSHYES;
  3609. #else
  3610.     DIE(no_func, "endpwent");
  3611. #endif
  3612. }
  3613.  
  3614. PP(pp_ggrnam)
  3615. {
  3616. #ifdef HAS_GROUP
  3617.     return pp_ggrent(ARGS);
  3618. #else
  3619.     DIE(no_func, "getgrnam");
  3620. #endif
  3621. }
  3622.  
  3623. PP(pp_ggrgid)
  3624. {
  3625. #ifdef HAS_GROUP
  3626.     return pp_ggrent(ARGS);
  3627. #else
  3628.     DIE(no_func, "getgrgid");
  3629. #endif
  3630. }
  3631.  
  3632. PP(pp_ggrent)
  3633. {
  3634.     dSP;
  3635. #ifdef HAS_GROUP
  3636.     I32 which = op->op_type;
  3637.     register char **elem;
  3638.     register SV *sv;
  3639.     struct group *grent;
  3640.  
  3641.     if (which == OP_GGRNAM)
  3642.     grent = (struct group *)getgrnam(POPp);
  3643.     else if (which == OP_GGRGID)
  3644.     grent = (struct group *)getgrgid(POPi);
  3645.     else
  3646.     grent = (struct group *)getgrent();
  3647.  
  3648.     EXTEND(SP, 4);
  3649.     if (GIMME != G_ARRAY) {
  3650.     PUSHs(sv = sv_newmortal());
  3651.     if (grent) {
  3652.         if (which == OP_GGRNAM)
  3653.         sv_setiv(sv, (I32)grent->gr_gid);
  3654.         else
  3655.         sv_setpv(sv, grent->gr_name);
  3656.     }
  3657.     RETURN;
  3658.     }
  3659.  
  3660.     if (grent) {
  3661.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3662.     sv_setpv(sv, grent->gr_name);
  3663.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3664.     sv_setpv(sv, grent->gr_passwd);
  3665.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3666.     sv_setiv(sv, (I32)grent->gr_gid);
  3667.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3668.     for (elem = grent->gr_mem; *elem; elem++) {
  3669.         sv_catpv(sv, *elem);
  3670.         if (elem[1])
  3671.         sv_catpvn(sv, " ", 1);
  3672.     }
  3673.     }
  3674.  
  3675.     RETURN;
  3676. #else
  3677.     DIE(no_func, "getgrent");
  3678. #endif
  3679. }
  3680.  
  3681. PP(pp_sgrent)
  3682. {
  3683.     dSP;
  3684. #ifdef HAS_GROUP
  3685.     setgrent();
  3686.     RETPUSHYES;
  3687. #else
  3688.     DIE(no_func, "setgrent");
  3689. #endif
  3690. }
  3691.  
  3692. PP(pp_egrent)
  3693. {
  3694.     dSP;
  3695. #ifdef HAS_GROUP
  3696.     endgrent();
  3697.     RETPUSHYES;
  3698. #else
  3699.     DIE(no_func, "endgrent");
  3700. #endif
  3701. }
  3702.  
  3703. PP(pp_getlogin)
  3704. {
  3705.     dSP; dTARGET;
  3706. #ifdef HAS_GETLOGIN
  3707.     char *tmps;
  3708.     EXTEND(SP, 1);
  3709.     if (!(tmps = getlogin()))
  3710.     RETPUSHUNDEF;
  3711.     PUSHp(tmps, strlen(tmps));
  3712.     RETURN;
  3713. #else
  3714.     DIE(no_func, "getlogin");
  3715. #endif
  3716. }
  3717.  
  3718. /* Miscellaneous. */
  3719.  
  3720. PP(pp_syscall)
  3721. {
  3722. #ifdef HAS_SYSCALL
  3723.     dSP; dMARK; dORIGMARK; dTARGET;
  3724.     register I32 items = SP - MARK;
  3725.     unsigned long a[20];
  3726.     register I32 i = 0;
  3727.     I32 retval = -1;
  3728.  
  3729.     if (tainting) {
  3730.     while (++MARK <= SP) {
  3731.         if (SvGMAGICAL(*MARK) && SvSMAGICAL(*MARK) && mg_find(*MARK, 't'))
  3732.         tainted = TRUE;
  3733.     }
  3734.     MARK = ORIGMARK;
  3735.     TAINT_PROPER("syscall");
  3736.     }
  3737.  
  3738.     /* This probably won't work on machines where sizeof(long) != sizeof(int)
  3739.      * or where sizeof(long) != sizeof(char*).  But such machines will
  3740.      * not likely have syscall implemented either, so who cares?
  3741.      */
  3742.     while (++MARK <= SP) {
  3743.     if (SvNIOK(*MARK) || !i)
  3744.         a[i++] = SvIV(*MARK);
  3745.     else
  3746.         a[i++] = (unsigned long)SvPVX(*MARK);
  3747.     if (i > 15)
  3748.         break;
  3749.     }
  3750.     switch (items) {
  3751.     default:
  3752.     DIE("Too many args to syscall");
  3753.     case 0:
  3754.     DIE("Too few args to syscall");
  3755.     case 1:
  3756.     retval = syscall(a[0]);
  3757.     break;
  3758.     case 2:
  3759.     retval = syscall(a[0],a[1]);
  3760.     break;
  3761.     case 3:
  3762.     retval = syscall(a[0],a[1],a[2]);
  3763.     break;
  3764.     case 4:
  3765.     retval = syscall(a[0],a[1],a[2],a[3]);
  3766.     break;
  3767.     case 5:
  3768.     retval = syscall(a[0],a[1],a[2],a[3],a[4]);
  3769.     break;
  3770.     case 6:
  3771.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5]);
  3772.     break;
  3773.     case 7:
  3774.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6]);
  3775.     break;
  3776.     case 8:
  3777.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]);
  3778.     break;
  3779. #ifdef atarist
  3780.     case 9:
  3781.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8]);
  3782.     break;
  3783.     case 10:
  3784.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9]);
  3785.     break;
  3786.     case 11:
  3787.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
  3788.       a[10]);
  3789.     break;
  3790.     case 12:
  3791.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
  3792.       a[10],a[11]);
  3793.     break;
  3794.     case 13:
  3795.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
  3796.       a[10],a[11],a[12]);
  3797.     break;
  3798.     case 14:
  3799.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
  3800.       a[10],a[11],a[12],a[13]);
  3801.     break;
  3802. #endif /* atarist */
  3803.     }
  3804.     SP = ORIGMARK;
  3805.     PUSHi(retval);
  3806.     RETURN;
  3807. #else
  3808.     DIE(no_func, "syscall");
  3809. #endif
  3810. }
  3811.  
  3812.